home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 12 / 012.d81 / gauss (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  3KB  |  98 lines
  1. 10 rem **********************
  2. 11 rem * program gauss, version i, by shlomo ginsburg, may 1984
  3. 12 rem * this solves a system of n linear equations with n unknowns
  4. 13 rem * it notifies the user when there is no solution
  5. 14 rem * variables:
  6. 15 rem * n      = number of equations
  7. 16 rem * a(i,j) = elements of the coefficient matrix  i,j=1,2,...,n
  8. 17 rem * b(i)   = elements of the right hand side (constants)
  9. 18 rem * k      = step indicator (a total of n-1 steps is rtrequired)
  10. 19 rem * r      = diagonal element by which equations are divided
  11. 20 rem * t      = temporary storage for row interchange
  12. 21 rem **********************
  13. 22 rem *
  14. 23 rem *
  15. 24 poke 53280,11:poke 53281,0
  16. 25 print"[147]     a system of n linear equations     ";
  17. 26 print"            gauss elimination           [146]"
  18. 30 rem * beginning of program - input
  19. 40 input " [158]number of equations (n[158])";n
  20. 45 ifn<1orn>80thenprint"try a better number!":fordl=1to500:next:goto40
  21. 46 print"                          "
  22. 50 dim a(n,n),b(n)
  23. 60 print" input the coefficients of a[158]"
  24. 70 for i=1 to n
  25. 80 for j=1 to n
  26. 90 print "  a("i","j")";
  27. 100 input "";a(i,j)
  28. 110 next j:next i
  29. 120 print" input the coefficients of [150]b[158]"
  30. 130 for i=1 to n
  31. 140 print "  b("i")";
  32. 150 input b(i)
  33. 160 next i
  34. 170 if n=1 then 540: rem single equation
  35. 180 for k=1 to n-1: rem step counter
  36. 190 r=a(k,k)
  37. 200 rem * check for zero diagonal. instead of zero we use 1/1000000
  38. 210 if abs(r)>.000001 then 390: rem no need for interchange
  39. 220 rem * interchange rows
  40. 230 for j=(k+1) to n
  41. 240 if abs(a(j,k))>.000001 then 260: rem found the row for interchange
  42. 250 goto 350: rem keep looking for row
  43. 260 for l=k to n: rem interchange row j with row k - a's
  44. 270 t=a(k,l)
  45. 280 a(k,l)=a(j,l)
  46. 290 a(j,l)=t
  47. 300 next l
  48. 310 t=b(k): rem interchange b's
  49. 320 b(k)=b(j)
  50. 330 b(j)=t
  51. 340 goto 390
  52. 350 next j
  53. 360 print "               no solution !            "
  54. 370 goto 700
  55. 380 rem * dividing row by diagonal element a(k,k)
  56. 390 r=a(k,k)
  57. 400 for j=(k+1) to n
  58. 410 a(k,j)=a(k,j)/r
  59. 420 next j
  60. 430 b(k)=b(k)/r
  61. 440 rem * elimination of x(k) from rows k+1, k+2, ... , n
  62. 450 for i=(k+1) to n
  63. 460 r=a(i,k)
  64. 470 for j=(k+1) to n
  65. 480 a(i,j)=a(i,j)-r*a(k,j)
  66. 490 next j
  67. 500 b(i)=b(i)-r*b(k)
  68. 510 next i
  69. 520 next k: rem end of steps
  70. 530 rem * last equation for a(n,n)
  71. 540 if abs(a(n,n))>.000001 then 570
  72. 550 print "              no  solution !            "
  73. 560 goto 700
  74. 570 b(n)=b(n)/a(n,n)
  75. 580 rem * backsubstitution
  76. 590 for i=1 to (n-1)
  77. 600 k=n-i
  78. 610 for j=(k+1) to n
  79. 620 b(k)=b(k)-a(k,j)*b(j)
  80. 630 next j:next i
  81. 640 print"[147]                 results                "
  82. 650 for i=1 to n
  83. 660 print"  touch any key to continue"
  84. 670 print"   x("i") =";b(i)
  85. 680 get a$:if a$="" then 680
  86. 690 next i
  87. 700 goto60000
  88. 800 :
  89. 60000 fordl=1to500:nextdl
  90. 60001 print"[147]would you like to try another?";
  91. 60002 poke198,0:wait198,1:geta$:ifa$<>"y"anda$<>"n"thenpoke53280,rnd(1)*15:goto60002
  92. 60004 ifa$="y"thenclr:restore:goto21
  93. 60006 goto63000
  94. 60010 :
  95. 63000 rem    connect back to l.s.
  96. 63002 print"[147]load"chr$(34)"payload"chr$(34)",8":print"run"
  97. 63004 poke198,0:poke631,13:poke632,13:poke198,2:end
  98.