Problema con routine

[ignazio.giuga]

Salve
dovendo risolvere un'equazione di secondo grado particolarmente complessa


ho pensato di implementare una routine VB su excel (devo risolverla per 350000 dati quindi non posso col risolutore).


Il mio problema è che ogni qualvolta provo la risoluzione, la routine mi si blocca all'interno del ciclo. Quelle poche che riesco a risolvere mi danno un risultato sbagliato (andando a verificare con il risolutore). Per es. inserendo u=26.7 e tm= 1 dovrebbe dare un lambda di circa 5. Potete aiutarmi ???? Grazie anticipatamente

[Anthony47]

Ciao ignazio, benvenuto nel forum.
Pero' il codice potevi anche inserirlo in formato Testo e non Immagine, cosi' potevamo provarlo anche noi...
Comunque secondo me il problema sta in quel While Abs(Errore) > Errore_max; perche' basta che con 1 "incremento" al coefficiente di moltiplicazione del Lambda iniziale si passi mettiamo da errore=+0.0011 a -0.0011 e il codice perdera' l'informazione che si e' superato il valore massimo e continuera' a incrementare all'infinito.
Recentemente ho dovuto risolvere una problema abbastanza analogo (calcolo ArcCos disponendo solo delle funzioni per calcolo del Sen e Cos) e l'ho risolto per convergenze successive a incrementi decrescenti su 7 decadi; vedi viewtopic.php?f=26&t=106495#p623332
Vedi se riesci a riciclare quella logica nel tuo calcolo; altrimenti posta il codice che usi e vedremo di lavorarci anche noi.

Ciao

[ignazio.giuga]

Scusami hai ragione, purtroppo sono nuovo di forum etc. Spero che così vada bene. Ti ringrazio davvero

Public Function SMB(u As Double, tm As Double) As Double

Dim g As Double
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double
Dim lambda As Double
Dim errore_max As Double
Dim incremento As Double
Dim prova As Double

g = 9.81
a = 6.5882
b = 0.0161
c = 0.3692
d = 2.2024
e = 0.8798


incremento = 0.001
errore_max = 0.3

errore = (g * tm / u) - a * Exp((b * lambda ^ 2 - c * lambda + d) ^ 0.5 + e * lambda)


While Abs(errore) > errore_max
prova = lambda * (1 + incremento)
If Abs((g * tm / u) - a * Exp((b * prova ^ 2 - c * prova + d) ^ 0.5 + e * prova)) > Abs(errore) Then
prova = lambda * (1 - incremento)
End If
lambda = prova
errore = (g * tm / u) - a * Exp((b * prova ^ 2 - c * prova + d) ^ 0.5 + e * prova)

Wend


SMB = lambda


End Function












Sub marittime()

[Anthony47]

Veramente il codice che hai allegato e' diverso dall'immagine...
Comunque mi pare che dobbiamo sviluppare il metodo Sverdrup-Munk-Bretschneider....
Nella mia interpretazione una funzione idonea e' questa:

Codice: Seleziona tutto

Function SMBz(ByVal u As Double, ByVal tm As Double) As Double
'vedi http://www.pc-facile.com/forum/posting.php?f=26&t=106561
Dim L0 As Long, TgVal As Double, myLevel As Long, myStep As Double, LTest As Double
Dim TestVal As Double, myExit As Boolean
'
'myTim = Timer
Const g As Double = 9.81
Const a As Double = 6.5882
Const b As Double = 0.0161
Const c As Double = 0.3692
Const d As Double = 2.2024
Const e As Double = 0.8798
LTest = 30
TgVal = g * tm / u
If TgVal <= 0.001 Then
    SMBz = CVErr(xlErrNA)
End If
myStep = 10
nxStep:
myLevel = myLevel + 1
myStep = myStep / 10
Do
    LTest = LTest - myStep
    TestVal = a * Exp((b * LTest ^ 2 - c * LTest + d) ^ 0.5 + e * LTest)
    If TestVal <= TgVal Then
        LTest = LTest + myStep
        myExit = True
    Else
        myExit = False
    End If
    If myExit Then Exit Do
'DoEvents
Loop
'DoEvents
If myLevel < 8 Then GoTo nxStep
SMBz = LTest
'Debug.Print ">> " & Format(Timer - myTim, "0.0000")
End Function


Si richiama con i valori di U (wind speed) e Tm (duration of the wind), es

Codice: Seleziona tutto

=SMBz(U;Tm)

Tieni pero' presente che ogni richiamo richiede circa 0.2-0.3 msec, per cui se parli di centinaia di migliaia di risultati da elaborare ci vorra' un po' di tempo; direi che e' meglio che provi prima con qualche migliaio di calcoli.

Ciao