home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug055.arc
/
SIMEQU.BAS
< prev
next >
Wrap
BASIC Source File
|
1979-12-31
|
3KB
|
103 lines
10 REM SIMULTANEOUS EQUATION SOLUTION
15 REM By Ralph Johnson 1-1982
20 REM
30 REM MAIN PROGRAM
40 GOSUB 1000 REM SETUP AND TITLE
50 GOSUB 1500 REM INPUT
60 GOSUB 2500 REM SOLUTION
70 GOSUB 3500 REM OUTPUT
80 INPUT"DO YOU WANT TO TRY NEW DATA (Y/N)?";AGAIN$
90 IF AGAIN$="y" OR AGAIN$="Y" THEN GOTO 50
100 STOP
110 REM end main program
120 REM
1000 REM SETUP AND TITLE
1005 PRINT CHR$(&H1A)
1010 PRINT" This program will solve a set of "
1020 PRINT"simultaneous equations. The A matrix"
1030 PRINT"should contain the variable coefficients"
1040 PRINT"and the b matrix should contain the "
1050 PRINT"constants. Make sure that the coefficients"
1060 PRINT"are in the same order in each equation."
1065 PRINT:PRINT CHR$(&H1B)")":PRINT"hit return to start"
1070 INPUT A$: PRINT CHR$(&H1B)"(": PRINT CHR$(&H1A)
1080 DIM A(20,20),B(20),C(20)
1090 RETURN
1100 REM end setup
1500 REM INPUT
1510 INPUT"HOW MANY EQUATIONS ARE THERE"; N%
1520 PRINT:PRINT:PRINT"NOW INPUT THE DATA"
1530 PRINT:PRINT
1540 FOR I%=1 TO N%
1550 FOR J%=1 TO N%
1560 PRINT"A(";I%;",";J%;")=";
1570 INPUT A(I%,J%)
1580 NEXT J%
1590 PRINT"B(";I%;")";
1600 INPUT B(I%)
1610 NEXT I%
1620 PRINT:RETURN
1630 REM end input
2500 REM SOLUTION
2510 FLAG%=0
2520 IF N%<>0 THEN GOTO 2560
2530 IF A(1,1)=0 THEN FLAG%=1: RETURN
2540 C(1)=B(1)/A(1,1)
2550 RETURN
2560 M%=N%-1
2570 FOR I%=1 TO M%
2580 H=ABS(A(I%,I%))
2590 L%=I%
2600 I1%=I%+1
2610 FOR J%=I1% TO N%
2620 IF ABS(A(J%,I%)) < H THEN 2650
2630 H=ABS(A(J%,I%))
2640 L%=J%
2650 NEXT J%
2660 IF H=0 THEN FLAG%=1: RETURN
2670 IF L%=I% THEN 2760
2680 FOR J%=1 TO N%
2690 G=A(L%,J%)
2700 A(L%,J%)=A(I%,J%)
2710 A(I%,J%)=G
2720 NEXT J%
2730 G=B(L%)
2740 B(L%)=B(I%)
2750 B(I%)=G
2760 FOR J%=I1% TO N%
2770 T=A(J%,I%)/A(I%,I%)
2780 FOR K%=I1% TO N%
2790 A(J%,K%)=A(J%,K%)-T*A(I%,K%)
2800 NEXT K%
2810 B(J%)=B(J%)-T*B(I%)
2820 NEXT J%
2830 NEXT I%
2840 IF A(N%,N%)=0 THEN FLAG%=1: RETURN
2850 C(N%)=B(N%)/A(N%,N%)
2860 I%=N%-1
2870 S=0
2880 I1%=I%+1
2890 FOR J%=I1% TO N%
2900 S=S+A(I%,J%)*C(J%)
2910 NEXT J%
2920 C(I%)=(B(I%)-S)/A(I%,I%)
2930 I%=I%-1
2940 IF I%>0 THEN 2870
2950 RETURN
2960 REM END SIMULTANEOUS EQU
3500 REM OUTPUT
3510 IF FLAG%=1 THEN PRINT "NO UNIQUE SOLUTION":
RETURN
3520 PRINT"SOLUTIONS":PRINT"=========":PRINT
3530 FOR I%=1 TO N%
3540 PRINT "x(";I%;")=";C(I%)
3550 NEXT I%
3560 INPUT "Do you want a print out (Y/N)";PR$
3570 IF PR$<>"Y" AND PR$<>"y" THEN GOTO 3700
3580 LPRINT"SOLUTIONS": LPRINT"=========": LPRINT
3590 FOR I%=1 TO N%
3600 LPRINT "x(";I%;")=";C(I%)
3610 NEXT I%
3700 RETURN
3710 REM end output