home *** CD-ROM | disk | FTP | other *** search
/ Tiger Disk 53 / Tiger_Disk_053_1998-08_Tiger-Crew-Disk_de_Side_B.d64 / gauss-jordan (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  4KB  |  179 lines
  1. 5 poke 53280,15:poke 53281,12:print""
  2. 10 rem simultane loesung linearer gleichungen
  3. 11 rem mit hilfe der gauss-jordan-elimination
  4. 12 rem variablen
  5. 14 rem   c1     loesungsvektor
  6. 15 rem   e1     fehleranzeige
  7. 16 rem   m1     maximale laenge
  8. 17 rem   n1     anzahl der zeilen
  9. 18 rem   n2     anzahl der spalten
  10. 19 rem   i2     hilfsmatrix
  11. 20 rem ende der variablen
  12. 30 rem
  13. 70 m1=8
  14. 80 dim z(8),a(8,8),c1(8),w(8,1),b(8,8),i2(8,3)
  15. 90 print"[147]simultane loesung mit hilfe"
  16. 100 print"der gauss-jordan-elimination"
  17. 110 gosub 500:rem eingabe-routine
  18. 120 gosub 5000:rem gauss-jordan-routine
  19. 130 rem
  20. 140 if n1>5 then 220
  21. 150 print"[153]        matrix-konstanten"
  22. 155 print
  23. 160 for i=1 to n1
  24. 170 : for j=1 to n2
  25. 180 :  printtab(10)a(i,j);
  26. 190 : next j
  27. 200 : printtab(25)z(i)
  28. 210 next i
  29. 220 print""
  30. 230 if e1=1 then printtab(6)"[158]fehler: matrix singulaer":goto 300
  31. 240 print"[144]        loesung"
  32. 250 print
  33. 260 for i=1 to n2
  34. 270 : printtab(10)int(c1(i)*100+.5)/100;
  35. 280 next i
  36. 290 print""
  37. 300 goto 9999
  38. 500 rem eingabe der daten
  39. 530 print
  40. 540 input"[159]anzahl der gleichungen:";n1
  41. 545 print""
  42. 550 if n1>m1 then 540
  43. 560 if n1<2 then 9999
  44. 570 n2=n1
  45. 580 for i=1 to n1
  46. 590 : print"gleichung";i
  47. 600 : for j=1 to n1
  48. 610 :  printtab(20)j;" ";
  49. 620 :  input a(i,j)
  50. 630 : next j
  51. 640 : input"                     c  ";z(i)
  52. 650 next i
  53. 660 return
  54. 5000 rem gauss-jordan matrix-inversion und loesung
  55. 5011 rem variablen
  56. 5013 rem   a      koeffizientenmatrix
  57. 5014 rem   b      hilfsarray
  58. 5015 rem   b1     groesster wert
  59. 5016 rem   c1     loesungsvektor
  60. 5017 rem   d3     determinantee
  61. 5018 rem   e1     fehleranzeige
  62. 5019 rem   h1     hilfsvariable
  63. 5020 rem   i2     hilfsmatrix
  64. 5021 rem   i3     zeilenindex
  65. 5022 rem   i4     spaltenindex
  66. 5023 rem   i5     anzeige fuer inverses drucken
  67. 5024 rem   n2      anzahl dr spalten
  68. 5025 rem   n3     anzahl der konstantenvektoren
  69. 5026 rem   p1     pivot-index
  70. 5027 rem   w      loesungsmatrix
  71. 5028 rem   z      konstantenvektor
  72. 5029 rem ende der variablen
  73. 5080 rem
  74. 5090 e1=0:rem wird 1 gesetzt,falls die matrix singulaer ist
  75. 5100 i5=0:rem falls 0,drucke die inverse matrix
  76. 5110 n3=1:rem anzahl der konstantenvektoren
  77. 5120 fori=1ton2
  78. 5130 : forj=1ton2
  79. 5140 :  b(i,j)=a(i,j)
  80. 5150 : nextj
  81. 5160 :  w(i,1)=z(i)
  82. 5170 :  i2(i,3)=0
  83. 5180 : next i
  84. 5190 : d3=1
  85. 5200 : fori=1ton2
  86. 5210 :  rem
  87. 5220 :  rem suche nach dem groessten (pivot-)element
  88. 5230 :  rem
  89. 5240 :  b1=0
  90. 5250 :  forj=1ton2
  91. 5260 :   if(i2(j,3)=1)then5350
  92. 5270 :  fork=1ton2
  93. 5280 :   if(i2(k,3)>1)then6120
  94. 5290 :   if(i2(k,3)=1)then5340
  95. 5300 :   if(b1>=abs(b(j,k)))then5340
  96. 5310 :   i3=j
  97. 5320 :   i4=k
  98. 5330 :   b1=abs(b(j,k))
  99. 5340 :  nextk
  100. 5350 : nextj
  101. 5360 : i2(i4,3)=i2(i4,3)+1
  102. 5370 : i2(i,1)=i3
  103. 5380 : i2(i,2)=i4
  104. 5390 : rem zeilenvertauschung,um das pivot-element in die diagonale zu bringen
  105. 5400 : if(i3=i4)then5540
  106. 5410 : d3=-d3
  107. 5420 : forl=1ton2
  108. 5430 :  h1=b(i3,l)
  109. 5440 :  b(i3,l)=b(i4,l)
  110. 5450 :  b(i4,l)=h1
  111. 5460 : nextl
  112. 5470 : if(n3<1)then5540
  113. 5480 : forl=1ton3
  114. 5490 :  h1=w(i3,l)
  115. 5500 :  w(i3,l)=e(i4,l)
  116. 5510 :  w(i4,l)=h1
  117. 5520 : nextl
  118. 5530 : rem division von pivot-zeile durch pivot-element
  119. 5540 : p1=b(i4,i4)
  120. 5550 : d3=d3*p1
  121. 5560 : b(i4,i4)=1
  122. 5570 : forl=1ton2
  123. 5580 :  b(i4,l)=b(i4,l)/p1
  124. 5590 : nextl
  125. 5600 : if(n3<1)then5660
  126. 5610 : forl=1ton3
  127. 5620 :  w(i4,l)=w(i4,l)/p1
  128. 5630 : nextl
  129. 5640 : rem
  130. 5650 : rem reduziere nicht-pivot-zeile
  131. 5660 : forl1=1ton2
  132. 5670 :  if(l1=i4)then5770
  133. 5680 :  t=b(l1,i4)
  134. 5690 :  b(l1,i4)=0
  135. 5700 : forl=1ton2
  136. 5710 :  b(l1,l)=b(l1,l)-b(i4,l)*t
  137. 5720 : nextl
  138. 5730 : if(n3<1)then5770
  139. 5740 : forl=1ton3
  140. 5750 :  w(l1,l)=w(l1,l)-w(i4,l)*t
  141. 5760 : nextl
  142. 5770 :nextl1
  143. 5780 nexti
  144. 5790 rem
  145. 5800 rem spaltenvertauschung
  146. 5810 rem
  147. 5820 fori=1ton2
  148. 5830 : l=n2-i+1
  149. 5840 : if(i2(l,1)=i2(l,2))then5920
  150. 5850 : i3=i2(l,1)
  151. 5860 : i4=i2(l,2)
  152. 5870 : fork=1ton2
  153. 5880 :  h1=b(k,i3)
  154. 5890 :  b(k,i3)=b(k,i4)
  155. 5900 :  b(k,i4)=h1
  156. 5910 : nextk
  157. 5920 nexti
  158. 5930 fork=1ton2
  159. 5940 : if(i2(k,3)<>1)then6120
  160. 5950 nextk
  161. 5960 e1=0
  162. 5970 fori=1ton2
  163. 5980 : c1(i)=w(i,1)
  164. 5990 nexti
  165. 6000 if(i5=1)then6140
  166. 6020 print"[147][158]inverse matrix":print
  167. 6030 fori=1ton2
  168. 6040 : forj=1ton2
  169. 6050 :  printtab(11)int(b(i,j)*100+.5)/100;
  170. 6060 : nextj
  171. 6070 : print
  172. 6080 nexti
  173. 6090 print""
  174. 6100 print"determinante=";d3
  175. 6110 return:rem falls die inverse gedruckt wird
  176. 6120 e1=1
  177. 6140 return:rem ende des gauss-jordan-unterprogramms
  178. 9999 end
  179.