XProfan

Titre de la fenêtre "LGS[n,(n+1)] avec Pivot-normalisierter Gauss-Elimination lösen"
' source: https://www.rhirte.de/vb/gleichsys.htm#lin
' Aus dem Pascal-Original dans XProfan übertragen par
' P. Specht avril 2012-04. aucun comment toujours geartete
' la responsabilité! Sämtliche Risiken liegén beim Anwender!
' attention, qui le contenu qui Originalmatrix wird modifié!
Font 2:randomize:cls rnd(8^8):set("decimals",15)
' Testmatrix-Dimensionen
Var n%=4
' LGS-Zeilen*(Spalten+1) GT.Lösungsvektor «Les droits Seite"
Déclarer A![n%,n%+1],x![n%],i%,j%,k%
Déclarer jmax%,kmax!,kmax%,merk%[n%]
Déclarer s!,max!,skal![n%]
' Testmatrix aufsetzen
a![1,1]=1 :a![1,2]=0 :a![1,3]=0 :a![1,4]=0 :a![1,5]=10'=Rechte page
a![2,1]=1 :a![2,2]=1 :a![2,3]=0 :a![2,4]=0 :a![2,5]=20'= ...
a![3,1]=1 :a![3,2]=0 :a![3,3]=1 :a![3,4]=0 :a![3,5]=30'= ..
a![4,1]=1 :a![4,2]=0 :a![4,3]=0 :a![4,4]=1 :a![4,5]=40'= .
' GaussPivot
' 1. Reihenfolge sichern

WhileLoop n%

    i%=&Boucle
    merk%[i%]=i%

Endwhile

' 2. Normalisierung

WhileLoop n%

    i%=&Boucle
    s!=0

    WhileLoop n%

        j%=&Boucle
        s!=s!+Abs(A![i%,j%])

    Endwhile

    skal![i%]=1/s!

Endwhile

' 3. Vorwärtselimination

WhileLoop n%-1

    k%=&Boucle
    max!=skal![k%]*Abs(A![k%,k%])
    kmax% = k%'Spalte avec max
    jmax% = k%'la ligne avec max

    WhileLoop k%,n%

        j%=&Boucle
        ' 4. Pivotzelle chercher

        WhileLoop k%,n%

            i%=&Boucle

            Si (skal![j%]*Abs(A![j%,i%]))>max!

                jmax%=j%
                kmax%=i%
                max! =skal![j%]*Abs(A![j%,i%])

            EndIf

        Endwhile

    Endwhile

    ' 5. Zeilentausch, si nötig

    Si jmax% <> k%

        WhileLoop k%,n%+1

            j%=&Boucle
            s!=A![k%,j%]
            A![k%,j%]=A![jmax%,j%]
            A![jmax%,j%]=s!

        Endwhile

        s!=skal![k%]
        skal![k%] = skal![jmax%]
        skal![jmax%] = s!

    EndIf

    ' 6. Spaltentausch, si nötig

    Si kmax% <> k%

        WhileLoop n%

            i%=&Boucle
            s! = A![i%,k%]
            A![i%,k%] = A![i%,kmax%]
            A![i%,kmax%] = s!

        Endwhile

        j% = merk%[k%]
        merk%[k%] = merk%[kmax%]
        merk%[kmax%] = j%

    EndIf

    ' 7. Eigentliche Elimination

    WhileLoop k%+1,n%

        i%=&Boucle
        s! = A![i%,k%]/A![k%,k%]
        A![i%,k%] = 0.0

        WhileLoop k%+1,n%+1

            j%=&Boucle
            A![i%,j%]=A![i%,j%]-s!*A![k%,j%]

        Endwhile

    Endwhile

Endwhile

' 8. Rückwärtsauflösung
x![merk%[n%]]=A![n%,n%+1]/A![n%,n%]

WhileLoop n%-1,1,-1

    i%=&Boucle
    s! = A![i%,n%+1]

    WhileLoop i%+1,n%

        j%=&Boucle
        s!=s!-A![i%,j%]*x![merk%[j%]]

    Endwhile

    x![merk%[i%]]=s!/A![i%,i%]

Endwhile

' 9. Ausgabe

Whileloop n%

    i%=&Boucle
    imprimer "x"+str$(i%);" = ";x![i%]
    ' format$("%e",x![i%])

endwhile

Waitinput
Fin