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 Sub
End If
ReDim y(n_n)
h = (y2 - y1) / n_n
For i = 0 To n_n
x(i) = x1 + i * h
Next i
If metodo = "trapecio" Then
integral = trapecio(x, n)
ElseIf metodo = "simpson" Then
integral = simpson(x, n)
End If
Cells(5, 2) = integral
End Sub
'Implemento la funcion trapezio para calcular la integral
Function trapecio(y() As Double, n_n As Integer) As Double
Dim i As Integer, f1 As Double, f2 As Double
Dim 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 simpson
Function simpson(y() As Double, n_n As Integer) As Double
Dim i As Integer, f1 As Double, f2 As Double, f3 As Double
Dim val As Double, h As Double, m_m As Integer
val = 0
m_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 y2
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, 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 Double
Dim 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_n
For i = 0 To n_n
x(i) = x1 + i * h
Next i
val = 0
m_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 biseccion
Sub ceros()
Dim xk As Double, a As Double, tolx As Double, tolf As Double, maxiter As Integer, numiter As Integer
Dim 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) = xk
Cells(20, 2) = numiter
End Sub
'implemento la sub del metodo de newton
Sub 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 * tolx
errf = 2 * tolf
k = 0
Cells(20 + k, 10) = k
Cells(20 + k, 11) = xk
Do While (errf > tolf Or errx > tolx) And k <= maxiter
g_xk = L - val
dg_xk = -func(xk)
xkmas1 = xk - g_xk / dg_xk
errx = Abs(xkmas1 - xk) / Abs(xkmas1)
errf = Abs(g_xk)
k = k + 1
xk = xkmas1
Cells(20 + k, 10) = k
Cells(20 + k, 11) = xk
Cells(20 + k, 12) = errx
Cells(20 + k, 13) = errf
Loop
numiter = k
End Sub
'esta sub no la he aun implementado a la espera de solucionar la del metodo de newton
Sub MetodoBiseccion(xk As Double, a As Double, tolx As Double, tolf As Double, numiter As Integer)
End Sub