Programación General > Visual Basic 6.0 e inferiores
Problema de hidraulica con integrales
xikito:
Hola me han puesto un problema de hidaulica relacionado con integrales y ceros de funciones. Es bastante liante y querria saber si alguien podria ayudarme, tengo en el 1º apartado una duda sobre como estimar el error relativo , y el apartado dos no acavo de programarlo bien:
Os dejo lo que he programado,para el apartado 1:
--- Código: Text ---Option Explicit Function func(y As Double) As Double Dim Q As Double, B_y As Double, G As Double, A_y As Double, I0 As Double, n As Double, Rh As Double, P_y As Double, b As Double, m As Double 'Implementamos la funcion que hay que integrar para encontrar la distancia Q = Hoja1.Cells(2, 1) G = Hoja1.Cells(2, 2) I0 = Hoja1.Cells(2, 3) n = Hoja1.Cells(2, 4) m = Hoja1.Cells(2, 5) b = Hoja1.Cells(2, 6) B_y = b + 2 * m * y A_y = (b + m * y) * y P_y = b + 2 * Sqr(1 + (m ^ 2) * y) Rh = A_y / P_y func = ((((Q ^ 2) * B_y) / (G * A_y ^ 3)) - 1) * (I0 - ((n * Q) / (A_y * Rh ^ (2 / 3))) ^ 2) ^ (-1) End Function Sub integracion() Dim metodo As String, y() As Double, n_n As Integer, y1 As Double, y2 As Double, i As Integer, h As Double, integral As Double [color=#40BF00]'Utilizo una sub que llame a la function trapezio o simpson segun se quiera [/color] metodo = Hoja1.Cells(2, 7) n_n = Hoja1.Cells(2, 8) y1 = Hoja1.Cells(2, 9) y2 = Hoja1.Cells(2, 10) If metodo = "simpson" And n_n Mod 2 <> 0 Then MsgBox "Para emplear el método de Simpson el número de intervalos debe ser par" Cells(5, 2) = "error" Exit SubEnd If ReDim y(n_n)h = (y2 - y1) / n_nFor i = 0 To n_n x(i) = x1 + i * hNext i If metodo = "trapecio" Then integral = trapecio(x, n)ElseIf metodo = "simpson" Then integral = simpson(x, n)End IfCells(5, 2) = integral End Sub 'Implemento la funcion trapezio para calcular la integral Function trapecio(y() As Double, n_n As Integer) As DoubleDim i As Integer, f1 As Double, f2 As DoubleDim val As Double, h As Double val = 0 For i = 0 To n_n - 1 f1 = func(y(i))f2 = func(y(i + 1))h = (y(i + 1) - y(i)) val = val + (h * (f1 + f2)) / 2 Next i trapecio = val End Function 'Implemento simpsonFunction simpson(y() As Double, n_n As Integer) As Double Dim i As Integer, f1 As Double, f2 As Double, f3 As DoubleDim val As Double, h As Double, m_m As Integer val = 0m_m = n_n / 2 For i = 1 To m_m f1 = func(y(2 * i - 2))f2 = func(y(2 * i - 1))f3 = func(y(2 * i)) h = y(i + 1) - y(i) val = val + (h / 3) * (f1 + 4 * f2 + f3) Next i simpson = val End Function -Para el apartado 2: Option Explicit 'Implemento la misma funcion que en el apartado anterior aunque en este caso lo que buscamos es el calado y2Function func(y As Double) As Double Dim Q As Double, B_y As Double, G As Double, A_y As Double, I0 As Double, n As Double, Rh As Double, P_y As Double, b As Double, m As Double, L As Double Q = Hoja1.Cells(2, 1) G = Hoja1.Cells(2, 2) I0 = Hoja1.Cells(2, 3) n = Hoja1.Cells(2, 4) m = Hoja1.Cells(2, 5) b = Hoja1.Cells(2, 6) L = Hoja1.Cells(17, 1) B_y = b + 2 * m * y A_y = (b + m * y) * y P_y = b + 2 * Sqr(1 + (m ^ 2) * y) Rh = A_y / P_y func = ((((Q ^ 2) * B_y) / (G * A_y ^ 3)) - 1) * (I0 - ((n * Q) / (A_y * Rh ^ (2 / 3))) ^ 2) ^ (-1) End Function 'Implemento el metodo de simpson Function simpson(y() As Double, n_n As Integer) As Double Dim i As Integer, f1 As Double, f2 As Double, f3 As DoubleDim val As Double, h As Double, m_m As Integer n_n = Hoja1.Cells(2, 8) y1 = Hoja1.Cells(2, 9) y2 = xk ReDim y(n_n)h = (y2 - y1) / n_nFor i = 0 To n_n x(i) = x1 + i * hNext i val = 0m_m = n_n / 2 For i = 1 To m_m f1 = func(y(2 * i - 2))f2 = func(y(2 * i - 1))f3 = func(y(2 * i)) h = y(i + 1) - y(i) val = val + (h / 3) * (f1 + 4 * f2 + f3) Next i simpson = val End Function 'Utilizo una sub que llame a la sub del metodo de newton o de la biseccionSub ceros() Dim xk As Double, a As Double, tolx As Double, tolf As Double, maxiter As Integer, numiter As IntegerDim metodo As String Hoja1.Activate xk = Cells(2, 9)tolx = Hoja1.Cells(17, 2)tolf = Cells(17, 3)metodo = Cells(17, 4)maxiter = Cells(17, 6) If metodo = "Newton" Then Call MetodoNewton(xk, tolx, tolf, numiter, maxiter)ElseIf metodo = "Biseccion" Then a = Cells(17, 5) Call MetodoBiseccion(xk, a, tolx, tolf, numiter)Else MsgBox " Método no reconocido" numiter = 0 End If Cells(20, 1) = xkCells(20, 2) = numiterEnd Sub 'implemento la sub del metodo de newtonSub MetodoNewton(xk As Double, tolx As Double, tolf As Double, numiter As Integer, maxiter As Integer) Dim k As Integer, xkmas1 As Double, g_xk As Double, dg_xk As Double, errx As Double, errf As Double, L As Double, val As Double errx = 2 * tolxerrf = 2 * tolf k = 0 Cells(20 + k, 10) = kCells(20 + k, 11) = xk Do While (errf > tolf Or errx > tolx) And k <= maxiter g_xk = L - valdg_xk = -func(xk)xkmas1 = xk - g_xk / dg_xk errx = Abs(xkmas1 - xk) / Abs(xkmas1)errf = Abs(g_xk) k = k + 1 xk = xkmas1Cells(20 + k, 10) = kCells(20 + k, 11) = xkCells(20 + k, 12) = errxCells(20 + k, 13) = errf Loop numiter = kEnd Sub 'esta sub no la he aun implementado a la espera de solucionar la del metodo de newtonSub MetodoBiseccion(xk As Double, a As Double, tolx As Double, tolf As Double, numiter As Integer) End Sub
m0skit0:
Hola xikito
¿Qué tal si usas las etiquetas para el código?
Gracias
xikito:
Etiquetas?¿ como lo hago?¿
m0skit0:
Si te fijas, al escribir o editar un post, tienes un botón arriba que pone CODE. Seleccionas el código (dándole un poco de formato primero), luego le das al botón y listo.
viewtopic.php?f=1&t=35955
xikito:
Ya esto hecho, gracias. Espero que ahora se lea mejor.
Navegación
[#] Página Siguiente
Ir a la versión completa