home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG058.ARC / SIMEQU.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  3KB  |  103 lines
  1. 10 REM  SIMULTANEOUS EQUATION SOLUTION
  2. 15 REM  By Ralph Johnson  1-1982
  3. 20 REM 
  4. 30    REM MAIN PROGRAM
  5. 40 GOSUB 1000        REM  SETUP AND TITLE
  6. 50 GOSUB 1500        REM  INPUT
  7. 60 GOSUB 2500        REM  SOLUTION
  8. 70 GOSUB 3500        REM  OUTPUT
  9. 80 INPUT"DO YOU WANT TO TRY NEW DATA (Y/N)?";AGAIN$
  10. 90 IF AGAIN$="y" OR AGAIN$="Y"  THEN GOTO 50
  11. 100 STOP
  12. 110    REM end main program
  13. 120 REM
  14. 1000    REM SETUP AND TITLE
  15. 1005 PRINT CHR$(&H1A)
  16. 1010 PRINT"   This program will solve a set of "
  17. 1020 PRINT"simultaneous equations.  The A matrix"
  18. 1030 PRINT"should contain the variable coefficients"
  19. 1040 PRINT"and the b matrix should contain the "
  20. 1050 PRINT"constants.  Make sure that the coefficients"
  21. 1060 PRINT"are in the same order in each equation."
  22. 1065 PRINT:PRINT CHR$(&H1B)")":PRINT"hit return to start"
  23. 1070 INPUT A$: PRINT CHR$(&H1B)"(": PRINT CHR$(&H1A)
  24. 1080 DIM A(20,20),B(20),C(20)
  25. 1090 RETURN
  26. 1100    REM end setup
  27. 1500    REM INPUT 
  28. 1510 INPUT"HOW MANY EQUATIONS ARE THERE"; N%
  29. 1520 PRINT:PRINT:PRINT"NOW INPUT THE DATA"
  30. 1530 PRINT:PRINT
  31. 1540 FOR I%=1 TO N%
  32. 1550    FOR J%=1 TO N%
  33. 1560       PRINT"A(";I%;",";J%;")=";
  34. 1570       INPUT A(I%,J%)
  35. 1580    NEXT J%
  36. 1590    PRINT"B(";I%;")";
  37. 1600    INPUT B(I%)
  38. 1610 NEXT I%
  39. 1620 PRINT:RETURN
  40. 1630    REM end input
  41. 2500    REM  SOLUTION
  42. 2510 FLAG%=0
  43. 2520  IF N%<>0 THEN GOTO 2560
  44. 2530  IF A(1,1)=0 THEN FLAG%=1: RETURN
  45. 2540  C(1)=B(1)/A(1,1)
  46. 2550  RETURN
  47. 2560  M%=N%-1
  48. 2570  FOR I%=1 TO M%
  49. 2580    H=ABS(A(I%,I%))
  50. 2590    L%=I%
  51. 2600    I1%=I%+1
  52. 2610    FOR J%=I1% TO N%
  53. 2620       IF ABS(A(J%,I%)) < H THEN 2650
  54. 2630       H=ABS(A(J%,I%))
  55. 2640       L%=J%
  56. 2650    NEXT J%
  57. 2660    IF H=0 THEN FLAG%=1: RETURN
  58. 2670    IF L%=I% THEN 2760
  59. 2680    FOR J%=1 TO N%
  60. 2690       G=A(L%,J%)
  61. 2700       A(L%,J%)=A(I%,J%)
  62. 2710       A(I%,J%)=G
  63. 2720    NEXT J%
  64. 2730    G=B(L%)
  65. 2740    B(L%)=B(I%)
  66. 2750    B(I%)=G
  67. 2760    FOR J%=I1% TO N%
  68. 2770       T=A(J%,I%)/A(I%,I%)
  69. 2780       FOR K%=I1% TO N%
  70. 2790        A(J%,K%)=A(J%,K%)-T*A(I%,K%)
  71. 2800       NEXT K%
  72. 2810       B(J%)=B(J%)-T*B(I%)
  73. 2820    NEXT J%
  74. 2830  NEXT I%
  75. 2840 IF A(N%,N%)=0 THEN FLAG%=1: RETURN
  76. 2850 C(N%)=B(N%)/A(N%,N%)
  77. 2860 I%=N%-1
  78. 2870 S=0
  79. 2880 I1%=I%+1
  80. 2890 FOR J%=I1% TO N%
  81. 2900    S=S+A(I%,J%)*C(J%)
  82. 2910 NEXT J%
  83. 2920 C(I%)=(B(I%)-S)/A(I%,I%)
  84. 2930 I%=I%-1
  85. 2940 IF I%>0 THEN 2870
  86. 2950 RETURN
  87. 2960     REM END SIMULTANEOUS EQU
  88. 3500    REM OUTPUT
  89. 3510 IF FLAG%=1 THEN PRINT "NO UNIQUE SOLUTION":
  90.      RETURN
  91. 3520 PRINT"SOLUTIONS":PRINT"=========":PRINT
  92. 3530 FOR I%=1 TO N%
  93. 3540     PRINT "x(";I%;")=";C(I%)
  94. 3550 NEXT I%
  95. 3560 INPUT "Do you want a print out (Y/N)";PR$
  96. 3570 IF PR$<>"Y" AND PR$<>"y" THEN GOTO 3700
  97. 3580 LPRINT"SOLUTIONS": LPRINT"=========": LPRINT
  98. 3590 FOR I%=1 TO N%
  99. 3600     LPRINT "x(";I%;")=";C(I%)
  100. 3610 NEXT I%
  101. 3700 RETURN  
  102. 3710     REM  end output
  103.