[tt]Option Explicit
Option Base 1
' Public calledfromplotmodeshape As Boolean 'findobjective can be called from two procedures
' deleted as public variable and move to a calling parameter
Public leftstate(4) As Double ' passed from findobjective to plotmodeshape
Function findstationmatrix(index As Integer, wt As Double, brgmult As Double)
' index tells which element we are accessing
' wt is trial value of w at which we are evaluating the stationmatrx
' brgmult is bearing stiffness multiplier
Dim tempstationmatrix(4, 4) As Double ' temporary placeholder for the output findstationmatrix
' can't assign directly to findstationmatrix() since would look like a function call
Dim Kbrg As Double ' temporary (prettier) name for pdata(index).bearingstiffness*Kmult
Dim J As Double ' temporary (prettier) name for pdata(index).jp
Dim ei As Double ' temporary (prettier) name for sdata(index).ei
Kbrg = pdata(index).brgstiffness * brgmult
J = pdata(index).jp ' note inclgryo option already factored in within getinputandinitialize module
ei = sdata(index).ei
If Worksheets("main").Range("lumpedmasscalc").Value = True Then
' LUMPED MASS CALC HERE
Dim L As Double
Dim m As Double
L = sdata(index).length
m = pdata(index).mpoint
tempstationmatrix(1, 1) = 1 + L ^ 3 * (m * wt ^ 2 - Kbrg) / (6 * ei)
tempstationmatrix(1, 2) = L + L ^ 2 * J * wt ^ 2 / (2 * ei)
tempstationmatrix(1, 3) = L ^ 2 / (2 * ei)
tempstationmatrix(1, 4) = L ^ 3 / (6 * ei)
tempstationmatrix(2, 1) = L ^ 2 * (m * wt ^ 2 - Kbrg) / (2 * ei)
tempstationmatrix(2, 2) = 1 + L * J * wt ^ 2 / ei
tempstationmatrix(2, 3) = L / ei
tempstationmatrix(2, 4) = L ^ 2 / (2 * ei)
tempstationmatrix(3, 1) = L * (m * wt ^ 2 - Kbrg)
tempstationmatrix(3, 2) = J * wt ^ 2
tempstationmatrix(3, 3) = 1
tempstationmatrix(3, 4) = L
tempstationmatrix(4, 1) = m * wt ^ 2 - Kbrg
tempstationmatrix(4, 2) = 0
tempstationmatrix(4, 3) = 0
tempstationmatrix(4, 4) = 1
Else
' DISTRIBUTED MASS CALC HERE
Dim k As Double ' kappa
Dim kfourth As Double 'k^4 will be handy value to store
Dim kL As Double ' k * Length of section
Dim C0 As Double
Dim S1 As Double
Dim C2 As Double
Dim S3 As Double
k = (wt ^ 2 * sdata(index).RhoAoverEI) ^ 0.25
kfourth = k ^ 4
kL = k * sdata(index).length
C0 = (Cos(kL) + Application.Cosh(kL)) / 2
S1 = (Sin(kL) + Application.Sinh(kL)) / 2 / k
C2 = (-Cos(kL) + Application.Cosh(kL)) / 2 / k ^ 2
S3 = (-Sin(kL) + Application.Sinh(kL)) / 2 / k ^ 3
tempstationmatrix(1, 1) = C0 - 1 / ei * S3 * Kbrg
tempstationmatrix(1, 2) = S1 + 1 / ei * C2 * J * wt ^ 2
tempstationmatrix(1, 3) = 1 / ei * C2
tempstationmatrix(1, 4) = 1 / ei * S3
tempstationmatrix(2, 1) = kfourth * S3 - 1 / ei * C2 * Kbrg
tempstationmatrix(2, 2) = C0 + 1 / ei * S1 * J * wt ^ 2
tempstationmatrix(2, 3) = 1 / ei * S1
tempstationmatrix(2, 4) = 1 / ei * C2
tempstationmatrix(3, 1) = kfourth * ei * C2 - S1 * Kbrg
tempstationmatrix(3, 2) = kfourth * ei * S3 + C0 * J * wt ^ 2
tempstationmatrix(3, 3) = C0
tempstationmatrix(3, 4) = S1
tempstationmatrix(4, 1) = kfourth * ei * S1 - C0 * Kbrg
tempstationmatrix(4, 2) = kfourth * ei * C2 + kfourth * S3 * J * wt ^ 2
tempstationmatrix(4, 3) = kfourth * S3
tempstationmatrix(4, 4) = C0
End If
findstationmatrix = tempstationmatrix
End Function
Function findobjective(ByVal wt As Double, ByVal brgmult As Double, calledfromplotmodeshape As Boolean)
' find objective function which will cross 0 at root w
' first input is wt which stands for w (radian frequency) Trial value
' second input is brgmult which is multiplier for bearing stiffness
' Dim omatrix( , ) As Double ' objective matrix
Dim omatrix(4, 4) As Double ' objective matrix
Dim stationmatrix(4, 4) As Double
Dim lastpointmatrix(4, 4) As Double
' Dim rowindex As Integer not needed?
' Dim colindex As Integer
Dim index As Integer
' Initialize omatrix as identit matrix
Call mequals(omatrix, idmatrix(4))
' Loop through all sections left-multiplying objective matrix by stationmatrix
For index = 1 To n
Call mequals(stationmatrix, findstationmatrix(index, wt, brgmult))
Call mequals(omatrix, lmult(stationmatrix, omatrix))
Next index
' Now done looping through N station matrix (station = point and field). Have one more point matrix
' Develop the last point matrix
Call mequals(lastpointmatrix, idmatrix(4))
' Note there can be no bearing at the last point matrix (if anything it is to left of last segment at n, not n+1
' J = pdata(n + 1).jp
lastpointmatrix(3, 2) = pdata(n + 1).jp * wt ^ 2
Call mequals(omatrix, lmult(lastpointmatrix, omatrix))
' findobjective = omatrix(3, 1) * omatrix(4, 2) - omatrix(4, 1) * omatrix(3, 2) ' function output
findobjective = omatrix(rz1, ln1) * omatrix(rz2, ln2) - omatrix(rz1, ln2) * omatrix(rz2, ln1) ' function output
If calledfromplotmodeshape Then ' in this case we want to return the leftstate vector
leftstate(ln1) = -1
leftstate(ln2) = omatrix(rz1, ln1) / omatrix(rz1, ln2)
' above based on omatrix(rz1, ln1) *leftstate(ln1) + omatrix(rz1,ln2) * leftstate(ln2) = 0
' set leftstate(ln1)=-1
' leftstate(ln2)=omatrix(rz1,ln1)/omatrix(rz1,ln2)
' or could have used omatrix(rz1, ln1) *leftstate(ln1) + omatrix(rz1,ln2) * leftstate(ln2) = 0
' which would lead to ' leftstate(ln2)=omatrix(rz2,ln1)/omatrix(rz2,ln2)
leftstate(lz1) = 0
leftstate(lz2) = 0
End If
End Function ' end of findobjective
Function bisect(wlast As Double, wthis As Double, objlast As Double, objthis As Double, brgmult As Double) As Double
' bisection algorithm to find root w which satisfies objectivefunction(w,brgmult)~0
' inputs are two frequencies (wlast and wthis) and associated values (objlast and objthis)
' the module assumes one of the two (objlast or objthis) is positive and one negative
' thus there must be a root in between wlast and wthis
' the bisection algorithm tries the midpoint of the interval and tests for + or - objective function
' then use the new half-size interval (still positive at one endpoint and neg at the other) for new test
' repeat until we get within our required frequency tolerance freqtol
Dim lower As Double ' stores the value of w which gives negative objective function
Dim upper As Double ' stores the value of w which gives positive objective function
Dim trial As Double
' should add a check for one positive and one negative and should add itercounter.
If objlast < objthis Then
lower = wlast
upper = wthis
Else
lower = wthis
upper = wlast
End If
Do While Abs(upper - lower) > freqtol * 2 * pi
trial = (upper + lower) / 2
If findobjective(trial, brgmult, False) > 0 Then
upper = trial
Else
lower = trial
End If
Loop
bisect = (upper + lower) / 2
End Function ' bisect
[/tt]