Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0087/lan1.bas
There is 1 other file named lan1.bas in the archive. Click here to see a list.
00010 ' LAN1.BAS DUANE MOORE D I G I T A L
00020 ' READS THE FILE *CONFIG.LAN* AND *FREQ.LAN* TO PRODUCE THE
00030 ' FILE *YPARAM.LAN*.
00040 '
00050 ' 3-22-75
00060 '
00070 '
00080 LET C9=0
00090 GOTO 110
00100 LET C9=1
00110 FILES YPARAM.LAN,CONFIG.LAN,FREQ.LAN
00120 DIM G(20,20),C(20,20),L(20,20),A0(20,20),A1(20,20),B0(20,20),B1(20,20)
00130 SCRATCH #1
00140 MARGIN #1,130
00150 LET Q8=1
00160 LET F8=1
00170 LET V8=1
00180 LET A8=1
00190 PRINT
00200 PRINT "LAN1 Y-PARAMETER FILE GENERATOR"
00210 PRINT
00220 PRINT "NUMBER OF NODES (INCLUDING THE DATUM NODE)";
00230 INPUT #2,N
00240 PRINT N
00250 IF N>2 GOTO 290
00260 IF N<101 GOTO 290
00270 PRINT "ILLEGAL SIZE."
00280 STOP
00290 MAT G=ZER(N,N)
00300 MAT C=ZER(N,N)
00310 MAT L=ZER(N,N)
00320 MAT A0=ZER(N,N)
00330 MAT A1=ZER(N,N)
00340 MAT B0=ZER(N,N)
00350 MAT B1=ZER(N,N)
00360 DIM Y0(2,2),Y1(2,2),T(10),C0(4),C1(4),C2(4),C3(4)
00370 PRINT "*";
00380 INPUT #2,A$
00390 PRINT A$
00400 IF A$="PAS" GOTO 450
00410 IF A$="ACT" GOTO 620
00420 IF A$="XCT" GOTO 2960
00430 PRINT "WHAT?"
00440 GOTO 370
00450 ' PASSIVE FORMAT: [R,G,L OR C],[NODE],[NODE],[VALUE]
00460 PRINT "PAS>";
00470 INPUT #2,B$,N0,N1,V
00480 PRINT B$","N0","N1","V
00490 IF N0>N GOTO 600
00500 IF N0<0 GOTO 600
00510 IF N1>N GOTO 600
00520 IF N1<0 GOTO 600
00530 IF N0=N1 GOTO 370
00540 IF B$="R" GOTO 3370
00550 IF B$="G" GOTO 3410
00560 IF B$="L" GOTO 3490
00570 IF B$="C" GOTO 3450
00580 PRINT "ILLEGAL COMPONENT."
00590 STOP
00600 PRINT "ILLEGAL NODE."
00610 STOP
00620 ' ACTIVE FORMAT: [Q,F,V, OR A],[ID#],[NODE],[NODE],[NODE]
00630 PRINT "ACT>";
00640 INPUT #2,B$,V,N0,N1,N2
00650 PRINT B$","V","N0","N1","N2
00660 IF N0>N GOTO 600
00670 IF N1>N GOTO 600
00680 IF N2>N GOTO 600
00690 IF N0<0 GOTO 600
00700 IF N1<0 GOTO 600
00710 IF N2<0 GOTO 600
00720 IF N0=N1 GOTO 370
00730 IF B$="Q" GOTO 830
00740 IF B$="F" GOTO 1410
00750 IF B$="V" GOTO 1800
00760 IF B$="A" GOTO 2200
00770
00780
00790
00800
00810
00820 GOTO 580
00830 ' TRANSISTOR INPUT
00840 LET K9=300 'AMBIENT TEMPERATURE (KELVIN)
00850 IF Q8<>1 GOTO 930
00860 PRINT "NUMBER OF BIPOLAR TRANSISTORS";
00870 INPUT #2,Q9
00880 PRINT Q9
00890 MAT Q=ZER(Q9,12)
00900
00910
00920
00930 LET I=Q8
00940 LET Q(I,12)=V
00950 LET Q(I,1)=N0
00960 LET Q(I,2)=N1
00970 LET Q(I,3)=N2
00980 FOR J=1 TO I-1
00990 IF Q(I,12)=Q(J,12) GOTO 1020
01000 NEXT J
01010 GOTO 1060
01020 FOR K=4 TO 11
01030 LET Q(I,K)=Q(J,K)
01040 NEXT K
01050 GOTO 1390
01060 PRINT "TYPE '1' FOR GERMANIUM";
01070 INPUT #2,Q(I,11)
01080 PRINT Q(I,11)
01090 IF Q(I,11)=1 GOTO 1130
01100 IF Q(I,11)<1 GOTO 1120
01110 IF Q(I,11)<2 GOTO 1130
01120 LET Q(I,11)=2
01130 PRINT "Q-POINT EMITTER CURRENT (MA)";
01140 INPUT #2,Q(I,4)
01150 PRINT Q(I,4)
01160 LET Q(I,11)=8.625E-2*K9/Q(I,4)/Q(I,11)
01170 PRINT "HIE";
01180 INPUT #2,Q(I,4)
01190 PRINT Q(I,4)
01200 PRINT "HRE";
01210 INPUT #2,Q(I,5)
01220 PRINT Q(I,5)
01230 PRINT "HFE";
01240 INPUT #2,Q(I,6)
01250 PRINT Q(I,6)
01260 PRINT "HOE";
01270 INPUT #2,Q(I,7)
01280 PRINT Q(I,7)
01290 PRINT "COB";
01300 INPUT #2,Q(I,8)
01310 PRINT Q(I,8)
01320 INPUT #2,Q(I,10)
01330 IF Q(I,10)>0 GOTO 1380
01340 PRINT "CIB";
01350 INPUT #2,Q(I,9)
01360 PRINT Q(I,9)
01370 GOTO 1390
01380 PRINT "FT"Q(I,10)
01390 LET Q8=I+1
01400 GOTO 620
01410 ' FET INPUT
01420 IF F8<>1 GOTO 1500
01430 PRINT "NUMBER OF FET'S";
01440 INPUT #2,F9
01450 PRINT F9
01460 MAT F=ZER(F9,9)
01470
01480
01490
01500 LET I=F8
01510 LET F(I,9)=V
01520 LET F(I,1)=N0
01530 LET F(I,2)=N1
01540 LET F(I,3)=N2
01550 FOR J=1 TO I-1
01560 IF F(I,9)=F(J,9) GOTO 1590
01570 NEXT J
01580 GOTO 1630
01590 FOR K=4 TO 8
01600 LET F(I,K)=F(J,K)
01610 NEXT K
01620 GOTO 1780
01630 PRINT "TRANSCONDUCTANCE (GM)";
01640 INPUT #2,F(I,4)
01650 PRINT F(I,4)
01660 PRINT "OUTPUT ADMITTANCE (GO)";
01670 INPUT #2,F(I,5)
01680 PRINT F(I,5)
01690 PRINT "CAPACITANCE C(ISS)";
01700 INPUT #2,F(I,6)
01710 PRINT F(I,6)
01720 PRINT "CAPACITANCE C(RSS)";
01730 INPUT #2,F(I,7)
01740 PRINT F(I,7)
01750 PRINT "CAPACITANCE C(OSS)";
01760 INPUT #2,F(I,8)
01770 PRINT F(I,8)
01780 LET F8=I+1
01790 GOTO 620
01800 ' VACUUM TUBE INPUT
01810 IF V8<>1 GOTO 1890
01820 PRINT "NUMBER OF VACUUM TUBES";
01830 INPUT #2,V9
01840 PRINT V9
01850 MAT V=ZER(V9,9)
01860
01870
01880
01890 LET I=V8
01900 LET V(I,9)=V
01910 LET V(I,1)=N0
01920 LET V(I,2)=N1
01930 LET V(I,3)=N2
01940 FOR J=1 TO I-1
01950 IF V(I,9)=V(J,9) GOTO 1980
01960 NEXT J
01970 GOTO 2020
01980 FOR K=4 TO 8
01990 LET V(I,K)=V(J,K)
02000 NEXT K
02010 GOTO 2180
02020 PRINT "TRANSCONDUCTANCE (GM)";
02030 INPUT #2,V(I,4)
02040 PRINT V(I,4)
02050 PRINT "PLATE RESISTANCE (RP)";
02060 INPUT #2,V(I,5)
02070 PRINT V(I,5)
02080 LET V(I,5)=1/V(I,5)
02090 PRINT "CAPACITANCE C(GK)";
02100 INPUT #2,V(I,6)
02110 PRINT V(I,6)
02120 PRINT "CAPACITANCE C(GP)";
02130 INPUT #2,V(I,7)
02140 PRINT V(I,7)
02150 PRINT "CAPACITANCE C(PK)";
02160 INPUT #2,V(I,8)
02170 PRINT V(I,8)
02180 LET V8=I+1
02190 GOTO 620
02200 ' OP AMP INPUT
02210 IF A8<>1 GOTO 2410
02220 PRINT "NUMBER OF OP AMPS";
02230 INPUT #2,A9
02240 PRINT A9
02250 IF A9=1 GOTO 2270
02260 PRINT "MAXIMUM ";
02270 PRINT "NUMBER OF LOW-PASS BREAKPOINTS";
02280 INPUT #2,A7
02290 PRINT A7
02300 IF A9=1 GOTO 2320
02310 PRINT "MAXIMUM ";
02320 PRINT "NUMBER OF RECIPROCAL-LOW-PASS BREAKPOINTS";
02330 INPUT #2,A6
02340 PRINT A6
02350 LET A5=9+A6+A7
02360 MAT A=ZER(A9,A5)
02370
02380
02390
02400
02410 LET I=A8
02420 LET A(I,1)=V
02430 LET A(I,2)=N0
02440 LET A(I,3)=N1
02450 LET A(I,4)=N2
02460 FOR J=1 TO I-1
02470 IF A(I,1)=A(J,1) GOTO 2920
02480 NEXT J
02490 PRINT "INPUT RESISTANCE";
02500 INPUT #2,A(I,5)
02510 PRINT A(I,5)
02520 PRINT "OPEN LOOP VOLTAGE GAIN";
02530 INPUT #2,A(I,6)
02540 PRINT A(I,6)
02550 PRINT "OUTPUT RESISTANCE";
02560 INPUT #2,A(I,7)
02570 PRINT A(I,7)
02580 LET A3$="LOW-PASS"
02590 LET A2=A7
02600 LET A1=0
02610 GOSUB 2760
02620 LET A3$="RECIPROCAL-LOW-PASS"
02630 LET A2=A6
02640 LET A1=A7
02650 GOSUB 2760
02660 PRINT "ORDER OF HIGH-PASS-BREAKPOINT (IF ANY)";
02670 INPUT #2,A(I,A5-1)
02680 PRINT A(I,A5-1)
02690 IF A(I,A5-1)<1 GOTO 2740
02700 PRINT "HIGH-PASS BREAK FREQUENCY (HZ.)";
02710 INPUT #2,A(I,A5)
02720 PRINT A(I,A5)
02730 IF A(I,A5)<1E-20 GOTO 2900
02740 LET A8=I+1
02750 GOTO 620
02760 IF A9<2 GOTO 2820
02770 PRINT "HOW MANY "A3$
02780 INPUT #2,A4
02790 PRINT A4
02800 IF A4<=A2 GOTO 2830
02810 PRINT A2 "IS MAXIMUM."
02820 LET A4=A2
02830 FOR J=8 TO A4+7
02840 PRINT A3$" BREAK FREQUENCY";
02850 INPUT #2,A(I,J+A1)
02860 PRINT A(I,J+A1)
02870 IF A(I,J+A1)<=0 GOTO 2900
02880 NEXT J
02890 RETURN
02900 PRINT "ILLEGAL BREAK FREQUENCY."
02910 STOP
02920 FOR K=5 TO A5
02930 LET A(I,J)=A(J,K)
02940 NEXT K
02950 GOTO 2740
02960 ' EXECUTE
02970 INPUT #3,F3$
02980 IF F3$="ONE" GOTO 3300
02990 IF F3$="STD" GOTO 3270
03000 PRINT F3$" SWEEP"
03010 PRINT "LOWEST FREQUENCY (HZ)";
03020 INPUT #3,F0
03030 PRINT F0
03040 IF F3$="LIN" GOTO 3060
03050 IF F0=0 GOTO 3210
03060 IF F0<0 GOTO 3210
03070 PRINT "HIGHEST FREQUENCY (HZ)";
03080 INPUT #3,F1
03090 PRINT F1
03100 IF F1<F0 GOTO 3210
03110 IF F3$="OCT" GOTO 3530
03120 IF F3$="MOD" GOTO 3230
03130 IF F3$="LOG" GOTO 3160
03140 PRINT "DELTA F (HZ)";
03150 GOTO 3170
03160 PRINT "NUMBER OF STEPS PER DECADE";
03170 INPUT #3,F2
03180 PRINT F2
03190 IF F2<=0 GOTO 3210
03200 GOTO 3530
03210 PRINT "ILLEGAL FREQUENCY."
03220 STOP
03230 LET F0=10^(INT(LOG(F0)/LOG(10)))
03240 LET F4=1
03250 LET F2=F0
03260 GOTO 3530
03270 PRINT "FREQUENCY OF OPERATION: ";
03280 LET F0=1E3
03290 GOTO 3320
03300 PRINT "FREQUENCY OF OPERATION";
03310 INPUT #3,F0
03320 PRINT F0 "HZ."
03330 LET F1=F0
03340 LET F2=1
03350 LET F$="LIN"
03360 GOTO 3530
03370 ' ENTER A RESISTANCE
03380 LET G(N0,N1)=G(N0,N1)-1E-3/V
03390 LET G(N1,N0)=G(N0,N1)
03400 GOTO 450
03410 ' ENTER A CONDUCTANCE
03420 LET G(N0,N1)=G(N0,N1)-1E-3*V
03430 LET G(N1,N0)=G(N0,N1)
03440 GOTO 450
03450 ' ENTER A CAPACITANCE
03460 LET C(N0,N1)=C(N0,N1)+1E-6*V
03470 LET C(N1,N0)=C(N0,N1)
03480 GOTO 450
03490 ' ENTER AN INDUCTANCE
03500 LET L(N0,N1)=L(N0,N1)+1E-3*V
03510 LET L(N1,N0)=L(N0,N1)
03520 GOTO 450
03530 'COMPONENT ARRAYS HAVE BEEN SET UP. REDUCE TO A 2X2 Y MATRIX.
03540 LET F=F0
03550 LET O=3.141592654*2*F 'LOOP ENTRY
03560 ' LOAD A0 FROM THE CONDUCTANCE MATRIX
03570 MAT A0=G
03580 ' SET UP THE PRINCIPAL DIAGONAL OF A0
03590 FOR I=1 TO N
03600 FOR J=1 TO I-1
03610 LET A0(I,I)=A0(I,I)-A0(I,J)
03620 NEXT J
03630 FOR J=I+1 TO N
03640 LET A0(I,I)=A0(I,I)-A0(I,J)
03650 NEXT J
03660 NEXT I
03670 ' ENTER CAPACITIVE SUSCEPTANCE INTO A1
03680 MAT A1=(-O)*C
03690 ' SUBTRACT THE INDUCTIVE SUSCEPTANCE
03700 FOR I=1 TO N
03710 FOR J=1 TO N
03720 IF L(I,J)=0 GOTO 3740
03730 LET A1(I,J)=A1(I,J)+1/(O*L(I,J))
03740 NEXT J
03750 NEXT I
03760 ' SET UP THE PRINCIPAL DIAGONAL OF A1
03770 FOR I=1 TO N
03780 FOR J=1 TO I-1
03790 LET A1(I,I)=A1(I,I)-A1(I,J)
03800 NEXT J
03810 FOR J=I+1 TO N
03820 LET A1(I,I)=A1(I,I)-A1(I,J)
03830 NEXT J
03840 NEXT I
03850 ' USE JUNCTION TRANSISTOR SPECIFICATIONS TO CALCULATE
03860 ' HYBRID PI MODEL.
03870 FOR I=1 TO Q9
03880 LET T(0)=Q(I,6)/((Q(I,6)+1)*Q(I,11))
03890 LET T(1)=T(0)/Q(I,6)
03900 LET T(2)=Q(I,4)-1/T(1)
03910 IF T(2)>0 GOTO 3950
03920 LET T(2)=100
03930 LET T(1)=1/(Q(I,4)-T(2))
03940 LET T(0)=Q(I,6)*T(1)
03950 LET T(3)=1/T(2)
03960 LET T(4)=Q(I,5)*T(1)
03970 LET T(5)=T(4)+T(3)+T(1)
03980 LET T(6)=O*Q(I,8)
03990 IF Q(I,10)=0 GOTO 4010
04000 LET Q(I,9)=T(0)*F/(O*Q(I,10))-Q(I,8)
04010 LET T(7)=O*Q(I,9)+T(6)
04020 LET T(8)=T(0)-T(4)
04030 ' CONVERT THE HYBRID PI MODEL PARAMETERS INTO COMPLEX Y PARAMETERS
04040 LET M0=1
04050 LET C0(1)=T(5)
04060 LET C1(1)=T(7)
04070 GOSUB 6170
04080 LET C2(1)=T(3)*T(3)/C2(1)
04090 LET C3(1)=-C3(1)
04100 GOSUB 6460
04110 LET Y0(1,1)=T(3)-C0(1)
04120 LET Y1(1,1)=-C1(1)
04130 LET M0=2
04140 LET C0(1)=-T(3)*T(4)
04150 LET C1(1)=T(6)*T(3)
04160 LET C0(2)=T(5)
04170 LET C1(2)=T(7)
04180 GOSUB 6170
04190 LET C2(1)=C2(1)/C2(2)
04200 LET C3(1)=C3(1)-C3(2)
04210 GOSUB 6460
04220 LET Y0(1,2)=C0(1)
04230 LET Y1(1,2)=C1(1)
04240 LET C0(1)=T(3)*T(8)
04250 LET C1(1)=-T(6)*T(3)
04260 LET C0(2)=T(5)
04270 LET C1(2)=T(7)
04280 GOSUB 6170
04290 LET C2(1)=C2(1)/C2(2)
04300 LET C3(1)=C3(1)-C3(2)
04310 GOSUB 6460
04320 LET Y0(2,1)=C0(1)
04330 LET Y1(2,1)=C1(1)
04340 LET M0=3
04350 LET C0(1)=T(8)
04360 LET C1(1)=-T(6)
04370 LET C0(2)=T(4)
04380 LET C1(2)=T(6)
04390 LET C0(3)=T(5)
04400 LET C1(3)=T(7)
04410 GOSUB 6170
04420 LET C2(1)=C2(1)*C2(2)/C2(3)
04430 LET C3(1)=C3(1)+C3(2)-C3(3)
04440 GOSUB 6460
04450 LET Y0(2,2)=Q(I,7)+T(4)+C0(1)-T(4)*(Q(I,6)+1)
04460 LET Y1(2,2)=T(6)+C1(1)
04470 LET T(0)=Q(I,1)
04480 LET T(1)=Q(I,2)
04490 LET T(2)=Q(I,3)
04500 GOSUB 4530
04510 NEXT I
04520 GOTO 4780
04530 ' ENTER COMPLEX Y PARAMETERS INTO THE B MATRIX IN THE POSITIONS
04540 ' SPECIFIED BY EMITTER, BASE, AND COLLECTOR NODE ID'S.
04550 MAT B0=ZER
04560 MAT B1=ZER
04570 FOR J=1 TO 2
04580 FOR J0=1 TO 2
04590 LET B0(T(J),T(J0))=Y0(J,J0)
04600 LET B1(T(J),T(J0))=Y1(J,J0)
04610 NEXT J0
04620 NEXT J
04630 ' CALCULATE THE OTHER 5 VALUES TO FORM AN INDEFINITE MATRIX
04640 LET B0(T(1),T(0))=-Y0(1,1)-Y0(1,2)
04650 LET B1(T(1),T(0))=-Y1(1,1)-Y1(1,2)
04660 LET B0(T(2),T(0))=-Y0(2,1)-Y0(2,2)
04670 LET B1(T(2),T(0))=-Y1(2,1)-Y1(2,2)
04680 LET B0(T(0),T(1))=-Y0(1,1)-Y0(2,1)
04690 LET B1(T(0),T(1))=-Y1(1,1)-Y1(2,1)
04700 LET B0(T(0),T(2))=-Y0(1,2)-Y0(2,2)
04710 LET B1(T(0),T(2))=-Y1(1,2)-Y1(2,2)
04720 LET B0(T(0),T(0))=-B0(T(0),T(1))-B0(T(0),T(2))
04730 LET B1(T(0),T(0))=-B1(T(0),T(1))-B1(T(0),T(2))
04740 ' ADD REAL AND IMAGINARY PARTS OF B MATRIX TO A MATRIX
04750 MAT A0=A0+B0
04760 MAT A1=A1+B1
04770 RETURN
04780 ' USE FET SPECIFICATIONS TO CALCULATE COMPLEX Y PARAMETERS
04790 FOR I=1 TO F9
04800 MAT Y0=ZER
04810 LET Y0(2,1)=F(I,4)
04820 LET Y0(2,2)=F(I,5)
04830 LET Y1(1,1)=O*(F(I,6)+F(I,7))
04840 LET Y1(1,2)=-O*F(I,7)
04850 LET Y1(2,1)=Y1(1,2)
04860 LET Y1(2,2)=O*(F(I,7)+F(I,8))
04870 LET T(0)=F(I,1)
04880 LET T(1)=F(I,2)
04890 LET T(2)=F(I,3)
04900 GOSUB 4530
04910 NEXT I
04920 ' USE TUBE SPECIFICATIONS TO CALCULATE COMPLEX Y PARAMETERS
04930 FOR I=1 TO V9
04940 MAT Y0=ZER
04950 Y0(2,1)=V(I,4)
04960 Y0(2,2)=V(I,5)
04970 LET Y1(1,1)=O*(V(I,6)+V(I,7))
04980 LET Y1(1,2)=-O*V(I,7)
04990 LET Y1(2,1)=Y1(1,2)
05000 LET Y1(2,2)=O*(V(I,7)+V(I,8))
05010 LET T(0)=V(I,1)
05020 LET T(1)=V(I,2)
05030 LET T(2)=V(I,3)
05040 GOSUB 4530
05050 NEXT I
05060 ' USE OP AMP SPECIFICATIONS TO CALCULATE COMPLEX Y PARAMETERS
05070 FOR I=1 TO A9
05080 MAT Y1=ZER
05090 LET Y0(1,1)=1/A(I,5)
05100 IF A(I,7)=0 GOTO 5130
05110 LET Y0(2,2)=1/A(I,7)
05120 GOTO 5140
05130 LET Y0(2,2)=1E20
05140 LET Y0(1,2)=0
05150 LET C2(1)=A(I,6)
05160 LET C3(1)=0
05170 FOR J=8 TO 7+A7
05180 IF A(I,J)=0 GOTO 5220
05190 LET C2(1)=C2(1)/(SQR(1+F*F/A(I,J)/A(I,J)))
05200 LET C3(1)=C3(1)-ATN(F/A(I,J))
05210 NEXT J
05220 FOR J=8+A7 TO A5-2
05230 IF A(I,J)=0 GOTO 5270
05240 LET C2(1)=C2(1)*SQR(1+F*F/A(I,J)/A(I,J))
05250 LET C3(1)=C3(1)+ATN(F/A(I,J))
05260 NEXT J
05270 FOR J=1 TO A(I,A5-1)
05280 LET C2(1)=C2(1)*F/(A(I,A5)*SQR(1+F*F/A(I,A5)/A(I,A5)))
05290 LET C3(1)=C3(1)+1.570796327-ATN(F/A(I,A5))
05300 NEXT J
05310 LET Y0(2,1)=C2(1)*COS(C3(1))/A(I,7)
05320 LET Y1(2,1)=C2(1)*SIN(C3(1))/A(I,7)
05330 LET T=A(I,2)
05340 LET U=A(I,3)
05350 LET V=A(I,4)
05360 LET A0(T,T)=A0(T,T)+Y0(1,1)
05370 LET A0(T,U)=A0(T,U)-Y0(1,1)
05380 LET A0(U,T)=A0(U,T)-Y0(1,1)
05390 LET A0(U,U)=A0(U,U)+Y0(1,1)
05400 LET A0(V,T)=A0(V,T)-Y0(2,1)
05410 LET A1(V,T)=A1(V,T)-Y1(2,1)
05420 LET A0(V,U)=A0(V,U)+Y0(2,1)
05430 LET A1(V,U)=A1(V,U)+Y1(2,1)
05440 LET A0(3,T)=A0(3,T)+Y0(2,1)
05450 LET A1(3,T)=A1(3,T)+Y1(2,1)
05460 LET A0(3,U)=A0(3,U)-Y0(2,1)
05470 LET A1(3,U)=A1(3,U)-Y1(2,1)
05480 LET A0(V,V)=A0(V,V)+Y0(2,2)
05490 LET A0(V,3)=A0(V,3)-Y0(2,2)
05500 LET A0(3,V)=A0(3,V)-Y0(2,2)
05510 LET A0(3,3)=A0(3,3)+Y0(2,2)
05520 NEXT I
05530
05540
05550 ' SUPRESS ALL NODES EXCEPT 1,2,&3.
05560 FOR K=N TO 4 STEP -1
05570 LET M0=1
05580 LET C0(1)=A0(K,K)
05590 LET C1(1)=A1(K,K)
05600 GOSUB 6170
05610 LET C2(3)=C2(1)
05620 LET C3(3)=C3(1)
05630 IF C2(3)<>0 GOTO 5680
05640 FOR I=1 TO K-1
05650 LET A0(I,I)=A0(I,I)+A0(I,K)
05660 NEXT I
05670 GOTO 5870
05680 FOR I=1 TO K-1
05690 LET C0(1)=A0(I,K)
05700 LET C1(1)=A1(I,K)
05710 GOSUB 6170
05720 LET C2(2)=C2(1)
05730 LET C3(2)=C3(1)
05740 FOR J=1 TO K-1
05750 LET C0(1)=A0(K,J)
05760 LET C1(1)=A1(K,J)
05770 GOSUB 6170
05780 LET C2(1)=C2(1)*C2(2)/C2(3)
05790 LET C3(1)=C3(1)+C3(2)-C3(3)
05800 GOSUB 6460
05810 LET B0(I,J)=A0(I,J)-C0(1)
05820 LET B1(I,J)=A1(I,J)-C1(1)
05830 NEXT J
05840 NEXT I
05850 MAT A0=B0
05860 MAT A1=B1
05870 NEXT K
05880 LET M0=4
05890 LET C0(1)=A0(1,1)
05900 LET C1(1)=A1(1,1)
05910 LET C0(2)=A0(1,2)
05920 LET C1(2)=A1(1,2)
05930 LET C0(3)=A0(2,1)
05940 LET C1(3)=A1(2,1)
05950 LET C0(4)=A0(2,2)
05960 LET C1(4)=A1(2,2)
05970 LET M0=4
05980 GOSUB 6170
05990 PRINT #1,F,C2(1),C3(1),C2(2),C3(2),C2(3),C3(3),C2(4),C3(4)
06000 IF F3$="LOG" GOTO 6060
06010 IF F3$="LIN" GOTO 6090
06020 IF F3$="MOD" GOTO 6110
06030 LET F=F*2
06040 IF F<=F1 GOTO 3550
06050 GOTO 6520
06060 LET F4=F4+1/F2
06070 LET F=F0*10^F4
06080 GOTO 6040
06090 LET F=F+F2
06100 GOTO 6040
06110 LET F4=F4+1
06120 IF F4<10 GOTO 6150
06130 LET F4=1
06140 LET F2=F2*10
06150 LET F=F4*F2
06160 GOTO 6040
06170 ' RECTANGULAR TO POLAR CONVERSION
06180 FOR M=1 TO M0
06190 IF C0(M)<>0 GOTO 6230
06200 LET C2(M)=ABS(C1(M))
06210 LET C3(M)=90*SGN(C1(M))
06220 GOTO6440
06230 IF C1(M)<>0 GOTO 6270
06240 LET C2(M)=C0(M)
06250 LET C3(M)=0
06260 GOTO6440
06270 IF ABS(C0(M))>1E18 GOTO 6330
06280 IF ABS(C0(M))<1E-18 GOTO 6330
06290 IF ABS(C1(M))>1E18 GOTO 6330
06300 IF ABS(C1(M))>=1E-18 GOTO 6400
06310 ' THE FOLLOWING 7 INSTRUCTIONS FINDS THE MAGNITUDE OF VERY LARGE
06320 ' OR VERY SMALL NUMBERS WITHOUT OVERFLOWS OR UNDERFLOWS.
06330 LET A0=LOG(ABS(C0(M)))
06340 LET A1=LOG(ABS(C1(M)))
06350 LET A2=(A0+A1)/2
06360 LET A0=EXP(2*(A0-A2))
06370 LET A1=EXP(2*(A1-A2))
06380 LET C2(M)=EXP(LOG(A0+A1)/2+A2)
06390 GOTO 6410
06400 LET C2(M)=SQR(C0(M)*C0(M)+C1(M)*C1(M))
06410 LET C3(M)=57.295779*ATN(C1(M)/C0(M))
06420 IF C0(M)>0 GOTO6440
06430 LET C2(M)=-C2(M)
06440 NEXT M
06450 RETURN
06460 ' POLAR TO RECTANGULAR CONVERSION
06470 FOR M=1 TO M0
06480 LET C0(M)=C2(M)*COS(C3(M)/57.295779)
06490 LET C1(M)=C2(M)*SIN(C3(M)/57.295779)
06500 NEXT M
06510 RETURN
06520 IF C9=0 GOTO 6540
06530 CHAIN LAN2
06540 CHAIN LAN,200
06550 END