vendredi 17 novembre 2017

Find system Variables ( u(1),U_EX_p2) at periodic time points

I need to create a if statement that when neq = 3 i find the values of a few variables when t= 0.5 , 1.0 , 1.5, 2.0.

if you run my code when neq =2 then you will see how the program should work. Its frustrating that i haven't been able to solve this. Any help on any part of the project would be greatly appreciated

look for

 ''''''''''''''************************''''''''''''***************
 CODE
 ''''''''''''''************************''''''''''''***************

so see where i think my problem area is.

thank you

Option Explicit
Sub Huens_Diff_eq()
Sheet1.Cells.Clear
'Application.SendKeys "^g ^a {DEL}"
'''''BASIC INPUTS
Dim neq As Double
neq = 3
'neq = 2
Dim e As Double
e = Exp(1)
Dim t_int As Integer
If neq = 2 Then t_int = 5
If neq = 3 Then t_int = 2
't_int = 5
Dim CritNum As Integer
CritNum = 3
Dim DSPstp As Integer
DSPstp = 5
Dim DSPcol As Integer
DSPcol = 8

'''''COUNTERS
Dim i As Integer
Dim j As Integer
Dim k As Double
Dim m As Double
Dim colOf As Integer
Dim rowOf As Integer

'''''EQUATION CONTROL
Dim h() As Double
ReDim h(CritNum)
Dim n As Double

'''''EQUATION CONTROL
Dim u() As Double
Dim uStar() As Double
Dim uOld() As Double
Dim uEx As Double

'''''FUCTION CONTROL
Dim f() As Double
Dim fOld() As Double

'''''TIME CONTROL
Dim t As Double
Dim tOld As Double
Dim tNew As Double

'''''DATA CONTROL
Dim U1_h() As Double
Dim DELTA_1EX() As Double
ReDim DELTA_1EX(DSPstp, CritNum)
Dim Ratio_error() As Double
ReDim Ratio_error(DSPstp, CritNum - 1)
ReDim U1_h(DSPstp, CritNum)
Dim U_EX() As Double
ReDim U_EX(DSPstp)



'''''SIZING ARRAY
ReDim u(neq)
ReDim uOld(neq)
ReDim uStar(neq)
ReDim f(neq)
ReDim fOld(neq)

If neq = 3 Then
u(1) = 0
u(2) = 0
u(3) = 0
h(1) = 0.1
h(2) = 0.05
h(3) = 0.01
Dim U_EX_p2() As Double
ReDim U_EX_p2(t_int / h(3))
End If


'''''INITAL VAULES' "It's A cook BOok"
If neq = 2 Then
h(1) = 0.1
h(2) = 0.05
h(3) = 0.025
u(1) = 2
u(2) = 0
End If
'''''POSITIONING
colOf = 22

rowOf = 2

'''''ALGORITHUM
For j = CritNum To 1 Step -1
t = 0
If neq = 3 Then
u(1) = 0
u(2) = 0
u(3) = 0
End If

If neq = 2 Then
u(1) = 2
u(2) = 0
End If

    Cells(1, 1 + colOf) = "h(" & j & ") = " & h(j)
    Cells(2, 1 + colOf) = "t"
    Cells(2, 2 + colOf) = "u(1)"
    Cells(2, 3 + colOf) = "u(2)"
    Cells(2, 4 + colOf) = "uEx"


    For n = 1 To (t_int / h(j))
       '''''''review and understand
        tOld = t
        t = tOld + h(j)
        For i = 1 To neq
            uOld(i) = u(i)
        Next i
        For i = 1 To neq
            fOld(i) = fDeriv(uOld, tOld, i, neq)
            uStar(i) = uOld(i) + h(j) * fOld(i)
        Next i
        For i = 1 To neq
            f(i) = fDeriv(uStar, t, i, neq)
            u(i) = uOld(i) + (h(j) * (fOld(i) + f(i))) / 2
        Next i
        i = i - 1

'''''EXACT SOLUTION
   If neq = 2 Then
         uEx = 2 * e ^ -t * (Cos((3 ^ 0.5) * t) + ((3 ^ 0.5) ^ -1) * Sin((3 ^ 0.5) * t))
   End If
   If neq = 3 And j = CritNum Then
         U_EX_p2(n) = u(1)
         uEx = U_EX_p2(n)
   End If
'''''EXACT SOLUTION

        Cells(n + 2, 1 + colOf) = t
        Cells(n + 2, 2 + colOf) = u(1)
        Cells(n + 2, 3 + colOf) = u(2)
        If neq = 2 Then Cells(n + 2, 4 + colOf) = uEx
        If neq = 3 Then
            If j < 3 Then Cells(n + 2, 4 + colOf) = U_EX_p2(n * (h(j)) * 100)
           ' If j = 2 Then Cells(n + 2, 4 + colOf) = U_EX_p2(n * (h(j)) * 100)
            If j = 3 Then Cells(n + 2, 4 + colOf) = U_EX_p2(n)

        End If

         If neq = 2 And (CInt(t * 1000) / 1000) = CInt(t) Then
            t = Round(t, 0)
            If j = CritNum Then U_EX(t) = uEx
            Debug.Print U_EX(t)
            U1_h(t, j) = u(1)
        End If

''''''''''''''************************''''''''''''***************
        If neq = 3 And (n / 10) = CInt(t * 10) Then
'           t = Round(t, 0)
            If j = CritNum Then U_EX(t) = U_EX_p2(n / 10)
            Debug.Print U_EX(t)
            U1_h(t, j) = u(1)
         ' Debug.Print U1_h(t, j)
        End If

'''''''''''''''''''''************************''''''''''''***************
    Next n


    colOf = colOf - 5
Next j
Cells(2 + rowOf, 1) = "TIME"
Cells(2 + rowOf, 2) = "EXACT"

If neq = 2 Then
Cells(rowOf, 9) = "(u(1)-EX)/(u(1)-EX)"
Cells(1 + rowOf, 9) = "0.05/0.1"
Cells(1 + rowOf, 10) = "0.025/0.05"
Cells(2 + rowOf, 9) = "ER1"
Cells(2 + rowOf, 10) = "ER2"
End If

If neq = 3 Then
Cells(rowOf, 9) = "(u(1)-EX)/(u(1)-EX)"
Cells(1 + rowOf, 9) = "0.05/0.1"
Cells(2 + rowOf, 9) = "ER1"
End If

For i = 1 To CritNum
Cells(1 + rowOf, 2 * i + 1) = "h(" & i & ")=" & h(i)
'Cells(1 + rowOf, 2 * i + 1) = "h(" & i & ")=" & h(i)

'If i = 1 Then Cells(1 + rowOf, 2 * i + 1) = "h("&i)="

 Cells(2 + rowOf, 2 * i + 1) = "u(1)"
 Cells(2 + rowOf, 2 * i + 2) = "u(1)-EX"
 Next i


 If neq = 2 Then k = 1
 If neq = 3 Then k = 0.5
 i = 1
 For m = k To t_int Step k
 Cells(i + 2 + rowOf, 1) = m
 Cells(i + 2 + rowOf, 2) = U_EX(i)
    For j = 1 To CritNum
            DELTA_1EX(i, j) = (U1_h(i, j) - U_EX(i))
            Cells(i + 2 + rowOf, 2 + 2 * j) = DELTA_1EX(i, j)
            Cells(i + 2 + rowOf, 1 + 2 * j) = U1_h(i, j)
            'Debug.Print U1_h(t, j)
            Next j
'''''''''''''''''''''''''fix
For j = 1 To CritNum - 1
If DELTA_1EX(i, j) = 0 Then Ratio_error(i, j) = 0
If DELTA_1EX(i, j) <> 0 Then Ratio_error(i, j) = DELTA_1EX(i, j + 1) / DELTA_1EX(i, j)

    Cells(i + 2 + rowOf, 8 + j) = Ratio_error(i, j)

Next j
i = i + 1
Next m

End Sub

Public Function fDeriv(u, t, i, neq) '"It's A coOk BOok"
If neq = 2 Then
    If i = 1 Then fDeriv = u(2)
    If i = 2 Then fDeriv = -2 * u(2) - 4 * u(1)
    Exit Function
End If
    If i = 1 Then fDeriv = u(2)
    If i = 2 Then fDeriv = u(3)
    If i = 3 Then fDeriv = 10 * Sin(6 * t) - 3 * u(3) - u(2) * u(1) ^ 2 - 2 * u(1)
End Function



























'If Round(tc, 0) = 1 Then Debug.Print t
      '  End If
''''
''''
''''
''''Sub a()
''''
'''''
'''''m = Int(15.6464)
''''
''''
''''Debug.Print m
''''
''''For i = 1 To 10
''''
''''m = 10 / i
''''
''''If i / Int(m) = 1 Then Debug.Print m
''''
''''Next i
''''End Sub
''''
''''

'      If t Mod n = 0 Then Debug.Print t

''''
'''''''''''''''''''''''sub e
'''''''''_____e_=_2.7182818284590_BY_DEF
'''''''by DEF whY WHEN i GOES TO A HIGHER NUMBER DOES THE OVER
'''''''FLOW ERROR COME UP. hOW CAN YOU AVOID AN BUILT IN ERROR MESSAGE
'''''''COME UP? IF OVERFLOW THEN YADDA YADDA YADDA
''''''' 2.71828182845905_____2.71828180114638_MY VALUE FROM BELOW  ERROR
'''''''ALSO WHY WAS (0) ^ -1 RETURNING ZERO
'''''''TRUE VALUE WIKI
'''''''2.71828182845904523536028747135266249775724709369995
''''Dim e As Double
'''''Dim fct As Double
''''fct = 1
''''For i = 0 To 100
''''  fct = (i * fct) ^ 1
''''  If fct = 0 Then fct = 1
''''  e = (fct ^ -1) + e
''''Next i
''''e = 2.71828182845905
''''
''''
''''
'''''''''COMPUTER e
''''e = Exp(1)
''''
''''
'''''''''Debug............................................
''''Debug.Print fct
'''''Debug.Print e
''''''Debug.Print fct
'''''Debug.Print fct
'''''Debug.Print e
''''
''''''''End Sub
''''
''''
''''
''''
'''''''''CLEARS IMMEDIATE SCREEN after the program and befpre?
'''''Application.SendKeys "^g ^a {DEL}"
''''
'''''''''FACTORIAL METHOD A
''''fct = Application.WorksheetFunction.Fact(6)
'''
'
'
'Option Explicit
'''
''Sub main()
''tOld = 1
''
''t = 45
''
''If tOld = 1 Then Debug.Print t
''
''End Sub
'''




'
''' Dim x As Double
''' Dim d As Double
'''
'''Dim dNumber As Double
''''dNumber = 0.5
''''If IsWholeNumber(dNumber) Then
''''    Call MsgBox(dNumber & " is a whole number.")
''''    'This will be false as 10.2 is not a whole number.'
''''End If
'''
'''dNumber = 1.0505
'''If isDivisible(dNumber, 0.5) Then
'''    Call MsgBox(dNumber & " is a whole number.")
'''    'This will be true as 11 is a whole number.'
'''End If
'''
'''
'''
'''End Sub
'''
''''Public Function IsWholeNumber(dNumber)
''''    'We use Round here to remove the possibility of floating point errors.'
''''    IsWholeNumber = Int(dNumber) = Round(dNumber, 1)
''''End Function
'''
'''
'''Function isDivisible(x As Double, d As Double) As Boolean
'''x = 1.541
'''d = 0.5
'''Dim m As Double
''' '  m = (x Mod d)
'''
'''End Function
'Dim m As Integer
'Dim d As Double
'Dim x As Double
'
'x = 1
'd = 0.5
'Debug.Print 8 Mod 4.5
'
'x = x * 10
''d = d * 10
''m = x Mod d
'' Debug.Print m
'End Sub

Aucun commentaire:

Enregistrer un commentaire