XProfan

Titre de la fenêtre "STEFFENSEN-ALGORITHMUS"
'   berechnet implizit qui "Biegung" qui Funktionskurve, nähert sich exponentiell.
'   NUR D' DEMONSTRATIONSZWECKE! aucun Gewähr! No warranties whatsoever!
' Original: 1987 John H Mathews, Californa State Univ.
Fenêtre Style 24:Font 2
Randomiser:CLS Tour(8^8)
Set("Décimal",15)
Déclarer DELTA!,EPSILON!,max&,ANS$,P0!,SMALL!,POLD!
Déclarer K&,COND&,P1!,P2!,p3!,P4!,DF0!,D1!,D2!,DP!,DF1!,Y3!,RELERR!
'*** ICI DIE FUNKTION SOWIE IHRE ABLEITUNG EINPROGRAMMIEREN:
'    FNF (X!) = X!*X!*X! - 3*X! + 2
Def FNF(1)  @!(1)*@!(1)*@!(1) - 3 * @!(1) + 2
'    FNF1(X!) = 3*X!*X! - 3
Def FNF1(1)  3*@!(1)*@!(1) - 3
'***********************************************************
Goto "G52"'skip imprimer subroutine
S30:
' DIE FUNKTION IN KLARTEXT AUSGEBEN:
REM SUBROUTINE PRINT FUNCTION
PRINT "         F(X)  =  X^3 - 3*X + 2  = 0            "
Retour
'***********************************************************
G52:
Goto "G100"
G100:
REM PROGRAM STEFFENS
DELTA!  =Val("1E-16")'Relative Fehlergrenze des Paramètres
EPSILON!=Val("1E-16")'Ansolute Funktionswert-Toleranz
MAX&=99'Maximale Anzahl à Iterationen
G140:
Gosub S300": REM SUBROUTINE INPUTS
GOSUB S400": REM SUBROUTINE STEFFENSEN
GOSUB S1000":REM SUBROUTINE RESULTS
PRINT
Imprimer
PRINT " ANDEREN STARTWERT PROBIEREN <j/n>? ";
Contribution ANS$
Casenote (ANS$="N") Or (ANS$="n"):GOTO "G140"
GOTO "G5000"
S300:
REM SUBROUTINE INPUTS
CLS Tour(8^8)
PRINT
PRINT " STEFFENSEN'S BESCHLEUNIGUNG DES NEWTON-RAPHSON-ALGORITHMUS "
PRINT "   ZUR NULLSTELLENSUCHE IN EINER (NICHTLINEAREN) FUNKTION   "
PRINT
Gosub S30"' ZU SUBROUTINE PRINT FUNCTION
PRINT
PRINT " Es wird un anfänglicher Startwert P0 nécessaire:"
PRINT " Gewünschter Startwert P0 = ";
Contribution P0!
PRINT
RETOUR
S400:
REM SUBROUTINE STEFFENSEN
SMALL!=Val("1E-20")
POLD!=P0!
K&=0
COND&=0
P3!=P0!
P2!=P0!+1
P1!=P0!+2

WHILE (K& < MAX&) And (COND& = 0)

    P0!=P3!
    DF0!=FNF1(P0!)

    Si DF0!<>0:Goto "G520"

        D'autre:Goto "G540"

    EndIf

    G520:
    P1!=P0! - FNF(P0!)/DF0!' Newton-Raphson-Schritt
    Goto "G590"
    G540:
    REM ELSE
    COND&=1
    DP!=P3!-P2!
    P3!=P0!
    Goto "G860"
    G590:
    REM ENDIF
    DF1!=FNF1(P1!)

    Si  DF1! <>0:Goto "G620"

        D'autre:Goto "G640"

    EndIf

    G620:
    P2!=P1! - FNF(P1!)/DF1!
    Goto "G690"
    G640:
    REM ELSE
    COND&=1
    DP!=P1!-P0!
    P3!=P1!
    Goto "G860"
    G690:
    REM ENDIF
    D1!=(P1!-P0!)*(P1!-P0!)
    D2!=P2!-2*P1!+P0!

    IF D2!=0:Goto "G730"

        D'autre:Goto "G770"

    EndIf

    G730:
    COND&=1
    DP!=P2!-P1!
    P3!=P2!
    GOTO "G800"
    G770:
    REM ELSE
    P3!=P0!-D1!/D2!
    DP!=P3!-P2!
    G800:
    REM ENDIF
    Y3!=FNF(P3!)
    RELERR!=Abs(DP!)/(Abs(P3!)+SMALL!)
    Cas RELERR! < DELTA!:  COND&=2
    Cas  Abs(Y3!) < EPSILON! : COND&=3
    Cas  (RELERR!  < DELTA!) And (Abs(Y3!) < EPSILON!) : COND&=4
    G860:
    REM WEITER
    K&=K&+1

ENDWHILE

P0!=POLD!
RETOUR
S1000:
REM SUBROUTINE RESULTS
CLS Tour(8^8)
PRINT
PRINT " STEFFENSEN'S BESCHLEUNIGUNG DES NEWTON-RAPHSON-ALGORITHMUS "
PRINT "   ZUR NULLSTELLENSUCHE IN EINER (NICHTLINEAREN) FUNKTION   "
PRINT
Gosub S30"'PRINT-SUBROUTINE
PRINT
PRINT " qui Startwert était P0 =",P0!
PRINT
PRINT " Pour "+Trim$(Str$(K&))+" Iterationen Pratiquement-Nullwert trouvé chez:"
Imprimer : Imprimer
Imprimer "    P =",P3!
Imprimer : Imprimer
PRINT "  DP  =",ABS(DP!)," ist sa relative Genauigkeit."
PRINT
Imprimer "  F(";Trim$(Str$(P3!));") =",FNF(P3!)
PRINT
Cas FNF(P3!)=0  : PRINT "  Berechnete Funktion ergab GENAU NULL! "

Si COND&=0:Goto "G1200"

    D'autre:Goto "G1240"

EndIf

PRINT "  qui Konvergenz des Verfahrens ist zweifelhaft. Begründung:"
PRINT
G1220:
PRINT "  Maximale Iterationszahl überschritten!"
Goto "G1400"
G1240:
REM ELSEIF

Si COND&=1:Goto "G1260"

    D'autre:Goto "G1280"

EndIf

G1260:
PRINT "  Verfahrenskonvergenz zweifelhaft, là Division par zéro."
Goto "G1400"
G1280:
REM ELSEIF

IF  COND&=2:Goto "G1300"

    D'autre:Goto "G1320"

EndIf

G1300:
PRINT "  Solution dedans qui programmierten Toleranzen."
Goto "G1400"
G1320:
REM ELSEIF

Si COND&=3:Goto "G1340"

    D'autre:Goto "G1360"

EndIf

G1340:
PRINT "  Funktionswert F(P) dedans qui Toleranzgrenzen."
Goto "G1400"
G1360:
REM ELSEIF

Si  COND&=4:Goto "G1380"

    D'autre: Goto "G1400"

EndIf

G1380:
PRINT "  qui paramètre-Wert  P et qui Funktionswert F(P) "
PRINT "  liegen beide dans den programmierten Toleranzen.       "
G1400:
REM ENDIF
Retour
G5000:
FIN