XProfan

Título de la ventana "ROMBERG-INTEGRATION"
'{Numerische Integration uno Funktionskurve
' después de el Rundungsfehler-resistenten Romberg-Verfahren
' (Siehe https://de.wikipedia.org/wiki/Werner_Romberg)
' Konvergiert en allen stetigen Características!
' Demo-Übersetzung después de XProfan 11.2a 2012-05 by P.Pájaro carpintero,
' Quelle: https://de.wikipedia.org/wiki/Romberg-Integration,
' plus zwei 30 Jahre alte EDV-Zeitschriften. Ohne Gewähr!
' Rechtslage ungeprüft! Nur para Demonstrationszwecke!
'}
'{ Initialisierung
Font 2:randomize:cls rnd(8^8):set("decimals",18)
AppendMenuBar 10,"Numerische Integration después de Rhomberg"
Declarar xu!,xo!,n!,g!,tmp!,Integral!
'}

proc Fnk :parámetros x!

    var a!=100
    var b!=50
    declarar y!,aa!,él%
    aa!=a!*a!

    if (a!<>0) and (a!<>x!)

        ' ======= PROGRAMMTEIL A =============
        y! = b!*sqrt(1-x!*x!/aa!)' ELLIPSE a , b
        ' ====================================

    más

        y!=-1*10^-35

    endif

    volver y!

ENDPROC

'{ Ein/Ausgabeteil
Begin:
imprimir "\n El Función es en Programmteil A programmiert!"
imprimir "\n Untere Integrationsgrenze Xu= ";:input xu!
imprimir "\n  Obere Integrationsgrenze Xo= ";:input xo!
imprimir "\n Abbruch-Genauigkeit [Stellen]: ";:input g!
g!=1/10^g!
Integral! = Romberg(xu!,xo!,g!)
imprimir "\n Ergebnis:\n"
imprimir " Das Flächen-Integral zwischen "
imprimir " ";xu!;" y ";xo!
imprimir " beträgt ";format$("%e",Integral!)
imprimir " con Fehlerschranke ";format$("%e",tmp!)
WaitInput
Goto "Begin"
'}

proc Romberg : parámetros xu!,xo!

    var anz&=10' Streifenzahl, empfohlen 10, 12, max.16 (Laufzeit quadratisch!)
    Declarar i&,j&,k&,n&[anz&+1],H![anz&+1],L![anz&,anz&],Q!
    n&[0]=2
    H![0]=(xo!-xu!)/n&[0]
    ' benutzt Trapezregel:
    L![0,0]=H![0]/2*(Fnk(xu!)+Fnk(xo!)+2*Fnk(xu!+H![0]))

    WhileLoop Anz&:j&=&Loop

        H![j&]=H![0]/(2^j&)
        n&[j&]=n&[0]*(2^j&)
        Q!=0

        whileLoop 0,n&[j&-1]-1:i&=&Loop

            Q!=Q! + Fnk(xu!+(2*i&+1)*H![j&])

        endwhile

        L![0,j&]=L![0,j&-1]/2+H![j&]*Q!

    EndWhile

    WhileLoop Anz&:k&=&Loop

        whileloop 0,Anz&-1:j&=&Loop

            L![k&,j&]=1/(2^(2*k&)-1)*(2^(2*k&)*L![k&-1,j&+1]-L![k&-1,j&])

        endwhile

        tmp!=abs(L![k&,0]-L![k&-1,1])
        caso tmp!<=g!:romper

    Endwhile

    ' tmp! enthält aktuelle Fehlergrenze
    volver L![k&,0]

ENDPROC