1  REM ***  HP TIME-SHARED BASIC PROGRAM LIBRARY  **********************
2  REM
3  REM         SOLVER:  SOLVES COMPLEX SIMULTANEOUS EQUATIONS
4  REM
5  REM         36149 (A820) REV A -- 7/71
6  REM
7  REM ***  CONTRIBUTED PROGRAM  ***************************************
8  REM
10  REM ****SOLVER*****FREQUENCY DEPENDENT COMPLEX EQUATIONS**
20  REM ********* VERSION 1 BY ED DIXON *******
30  REM ******** ALSO PLOTS A GRAPH FOR THE LAST VARIABLE******
40  C1=K1=T1=0
50  DIM K[200]
60  DIM G[200]
70  DIM A$[72]
80  DIM U[25]
90  READ Q7
100  IF Q7=9999 THEN 130
110  RESTORE 
120  GOTO 500
130  RESTORE 
140  PRINT "DO YOU WANT INSTRUCTIONS?"
150  INPUT A$
160  IF A$="NO" THEN 500
170  PRINT "SOLVER SOLVES N SIMULANEOUS EQUATIONS HAVING COMPLEX"
180  PRINT "COEFFICIENTS AND COMPLEX DRIVING SOURCES, WHERE THE"
190  PRINT "IMAGINARY PART OF THE ROOT IS FREQUENCY DEPENDANT."
200  PRINT "SOLVER ALSO PLOTS A GRAPH FOR THE LAST VARABLE AND"
210  PRINT "STEPS THE FREQUENCY IN 1-2-4-8 DECADES."
220  PRINT "THE FREQUENCY PART MAY CONTAIN A LINEAR PART AND "
230  PRINT "A INVERSE PART.  THE DATA IS FED AS FOLLOWS:"
240  PRINT 
250  PRINT TAB(5)"9900 DATA <FIRST COEFFICIENT OF FIRST EQUATION>"
260  PRINT TAB(5)"9901 DATA <SECOND COEFFICIENT OF FIRST EQUATION>"
270  PRINT TAB(5)"99-- ETC."
280  PRINT TAB(5)"99-- DATA <COEFFICIENTS OF DRIVING SOURCE>"
290  PRINT 
300  PRINT "FOR EXAMPLE TO SOLVE:"
310  PRINT 
320  PRINT TAB(5)"(3+(2W-1/4W)J)V1+ (-2+(0+1/W)J)V2= 1+2J"
330  PRINT 
340  PRINT TAB(5)"(1+(3W)J)V1 + (1+(2/W)J)V2= -2+0J"
350  PRINT 
360  PRINT "NOTE  W STANDS FOR OMEGA"
370  PRINT "THE DATA STATEMENTS WOULD BE:"
380  PRINT 
390  PRINT TAB(5)"9900 DATA 3,2,-4"
400  PRINT TAB(5)"9901 DATA -2,0,1"
410  PRINT TAB(5)"9902 DATA 1,3,0"
420  PRINT TAB(5)"9903 DATA 1,0,.5"
430  PRINT TAB(5)"9904 DATA 1,2,-2,0"
440  PRINT 
450  PRINT "THE DATA LINES SHOULD BE NUMBERED FROM 9900"
460  PRINT "THROUGH 9997"
470  PRINT "IF NO LINEAR OR INVERSE PARTS OF A COEFFICIENT EXIST"
480  PRINT " THEN ENTER ZERO'S"
490  GOTO 9999
500  FOR I=1 TO 1000
510  READ S1
520  IF S1=9999 THEN 540
530  NEXT I
540  LET T=(-2+SQR(4+(12*(I-1))))/6
550  RESTORE 
560  IF INT(T)=T THEN 590
570  PRINT "YOU HAVE A MISTAKE IN YOUR DATA STATEMENTS"
580  GOTO 9999
590  IF Q7 <> 9999 THEN 620
600  PRINT "YOU HAVE NOT PUT IN DATA YET."
610  GOTO 9999
620  PRINT "WOULD YOU LIKE TO COMPUTE SOME SPECIFIC VALUES OF F?"
630  INPUT A$
640  IF A$="NO" THEN 820
650  PRINT "HOW MANY?"
660  INPUT Q6
670  PRINT "INPUT THEM AS I CALL FOR THEM."
680  FOR I=1 TO Q6
690  PRINT "NO"I;
700  INPUT Q9
710  LET U[I]=Q9
720  NEXT I
730  PRINT "FREQ           MAG"
740  FOR L1=1 TO Q6
750  K=U[L1]
760  GOSUB 1060
770  PRINT U[L1]'13;
780  PRINT TAB(13);
790  PRINT SQR(A[2*T]^2+A[2*T-1]^2)
800  NEXT L1
810  GOTO 9999
820  PRINT "WHAT IS YOUR VALUE FOR F1 AND F2?"
830  INPUT F1,F2
840  PRINT "DO YOU ONLY WANT TO SEE THE GRAPH?"
850  INPUT A$
860  IF A$="NO" THEN 880
870  C1=1
880  DIM A[20]
890  DIM Y[20,21]
900  PRINT 
910  IF C1=1 THEN 940
920  PRINT "FREQ   VAR NO    REAL           IMAG             MAG";
930  PRINT "           ANGLE"
940  S=0
950  K=F1
960  IF S=0 THEN 980
970  K=2*K
980  IF K=16*F1 THEN 1000
990  GOTO 1020
1000  F1=10*F1
1010  GOTO 940
1020  T1=T1+1
1030  K[T1]=K
1040  GOSUB 1060
1050  GOTO 1690
1060  X=0
1070  W=2*3.14159*K
1080  LET R=2*T
1090  MAT A=ZER[R+1]
1100  MAT Y=ZER[R,R+1]
1110  FOR I=1 TO T
1120  FOR J=1 TO R
1130  IF (-1)^J>0 THEN 1160
1140  READ R1
1150  GOTO 1220
1160  READ C,L
1170  IF L=0 THEN 1200
1180  LET X1=-(W*C+1/(W*L))
1190  GOTO 1230
1200  LET X1=-W*C
1210  GOTO 1230
1220  X1=R1
1230  LET Y[2*I-1,J]=X1
1240  NEXT J
1250  FOR J=1 TO R
1260  LET Y[2*I,J]=(-1)^J*Y[2*I-1,J+(-1)^(J+1)]
1270  NEXT J
1280  NEXT I
1290  FOR I=1 TO R
1300  READ Y[I,R+1]
1310  NEXT I
1320  FOR Q=1 TO R-1
1330  LET B=Y[Q,Q]
1340  LET D=0
1350  FOR I=Q+1 TO R
1360  LET G=Y[I,Q]
1370  IF ABS(G)>ABS(B) THEN 1390
1380  GOTO 1430
1390  LET X=X
1400  LET D=1
1410  LET M=I
1420  LET B=G
1430  NEXT I
1440  IF D <> 1 THEN 1500
1450  FOR I=Q TO R+1
1460  LET C=Y[M,I]
1470  LET Y[M,I]=Y[Q,I]
1480  LET Y[Q,I]=C
1490  NEXT I
1500  LET X=0
1510  FOR P=Q+1 TO R
1520  IF Y[P,Q]=0 THEN 1560
1530  LET F=Y[P,Q]/Y[Q,Q]
1540  FOR N=Q+1 TO R+1
1550  LET Y[P,N]=Y[P,N]-(F*Y[Q,N])
1560  LET X=X
1570  NEXT N
1580  NEXT P
1590  NEXT Q
1600  FOR I=R TO 1 STEP -1
1610  LET A1=0
1620  FOR J=I+1 TO R
1630  LET A1=A1+Y[I,J]*A[J]
1640  NEXT J
1650  LET A[I]=(Y[I,R+1]-A1)/Y[I,I]
1660  NEXT I
1670  RESTORE 
1680  RETURN 
1690  IF C1=1 THEN 1720
1700  PRINT K
1710  PRINT "      ";
1720  K1=K1+1
1730  G[K1]=SQR(A[2*T]^2+A[2*T-1]^2)
1740  IF C1=1 THEN 1810
1750  FOR I=1 TO T
1760  PRINT I,A[2*I-1],A[2*I],SQR(A[2*I-1]^2+A[2*I]^2);
1770  V=A[2*I]
1772  H=A[2*I-1]
1774  GOSUB 2300
1776  PRINT A*(57.2958)
1780  PRINT "      ";
1790  NEXT I
1800  PRINT 
1810  IF K<F2 THEN 970
1820  PRINT "GRAPH FOLLOWS"'13'10'10'10
1830  PRINT "FREQ                     VARABLE NO."T
1840  PRINT "(TIMES 100)"
1850  PRINT "       ";
1860  GOSUB 2140
1870  PRINT '13;
1880  G1=0
1890  H1=1.E+08
1900  P$="*"
1910  FOR I=2 TO K1+1
1920  G1=G[I-1] MAX G1
1930  H1=G[I-1] MIN H1
1940  NEXT I
1950  PRINT TAB(6);INT(1000*H1)/1000'13;
1960  PRINT TAB(26);INT(1000*(H1+(G1-H1)/3))/1000'13;
1970  PRINT TAB(46);INT(1000*(H1+2*(G1-H1)/3))/1000;
1980  PRINT "     "INT(1000*G1)/1000
1990  PRINT "       ";
2000  GOSUB 2140
2010  FOR J=1 TO T1
2020  PRINT K[J]/100'13;
2030  PRINT "       ";
2040  FOR I=1 TO 65
2050  IF H1+(G1-H1)*I/65<G[J] THEN 2080
2060  PRINT P$
2070  GOTO 2100
2080  PRINT " ";
2090  NEXT I
2100  NEXT J
2110  PRINT TAB(7);
2120  GOSUB 2140
2130  GOTO 9999
2140  FOR I=1 TO 65
2150  S$="-"
2160  PRINT S$;
2170  NEXT I
2180  RETURN 
2300  REM THE SUBROUTINE FOR ATN STARTS HERE
2310  REM H=HORIZONTAL, V=VERTICAL, A=ANGLE
2320  IF H=0 THEN 2340
2330  GOTO 2360
2340  LET A=SGN(V)*1.5708
2350  RETURN 
2360  IF H>0 THEN 2380
2370  GOTO 2400
2380  LET A=ATN(V/H)
2390  RETURN 
2400  REM IF WE GO THIS FAR H<0
2410  IF V <> 0 THEN 2430
2420  GOTO 2450
2430  LET A=ATN(V/H)+SGN(V)*3.1416
2440  RETURN 
2450  LET A=-3.1416
2460  RETURN 
9998  DATA 9999
9999  END 
