Samer,
I have constructed the following subroutine, which I have checked using handbook methods and LMS tekware. (I will however not guarantee its accuracy.)
Public Sub FromToRainFlow()
'Counts cycles according to the rain flow algorithm.
'Precondition: dPeaks[]
'Postcondition: dFromToRain[]
Dim i, j, p As Long
Dim dWorkPeaks(1, 50000) As Double
Dim lWorkPos As Long
Dim lPeakPos As Long
Dim dFirstPeak As Double
Dim dMidPeak As Double
Dim dLastPeak As Double
Dim dFrontFlank As Double
Dim dBackFlank As Double
Dim sOutString As String
'initializes the lNoCycles[] array
For i = 1 To iNoCh
lNoCycles(i) = 0
Next i
'dWorkPeaks(b,i,n) b=0 -> subarray containing the level of the peak
' b=1 -> subarray containing the index of the peak in dPeaks[]
' i -> channel number
' n -> index
For i = 1 To iNoCh
dNoiseLvl = dMaxMax(i) / 1000
'Enter info for the first 3 peaks
dWorkPeaks(0, 0) = dPeaks(i, 0, 1)
dWorkPeaks(0, 1) = dPeaks(i, 0, 2)
dWorkPeaks(0, 2) = dPeaks(i, 0, 3)
dWorkPeaks(1, 0) = 1
dWorkPeaks(1, 1) = 2
dWorkPeaks(1, 2) = 3
lWorkPos = 2
lPeakPos = 2
Do While lPeakPos < lNoPeaks(i)
p = p + 1
'refills dWorkPeaks if it contains less than 3 peaks
If lWorkPos < 2 Then
For j = 1 To (2 - lWorkPos)
lPeakPos = lPeakPos + 1
lWorkPos = lWorkPos + 1
dWorkPeaks(0, lWorkPos) = dPeaks(i, 0, lPeakPos)
dWorkPeaks(1, lWorkPos) = lPeakPos
Next j
End If
dFirstPeak = dWorkPeaks(0, lWorkPos - 2)
dMidPeak = dWorkPeaks(0, lWorkPos - 1)
dLastPeak = dWorkPeaks(0, lWorkPos)
dFrontFlank = Abs(dLastPeak - dMiddlePeak)
dBackFlank = Abs(dMiddlePeak - dFirstPeak)
' dFromToRain[] contains the individual rain flow cycles
' dFromToRain(i,b,m) i -> channel
' b=0 -> start of cycle, index of peak in dPeaks[]
' b=1 -> mid of cycle, index of peak in dPeaks[]
' b=2 -> end of cycle, index of peak in dPeaks[]
' b=3 -> start of cycle, level
' b=4 -> mid of cycle, level
' m cycle index
If dFrontFlank > dBackFlank - dNoiseLvl Or dFrontFlank = dBackFlank Then
lNoCycles(i) = lNoCycles(i) + 1
dFromToRain(i, 0, lNoCycles(i)) = dWorkPeaks(1, lWorkPos - 2)
dFromToRain(i, 1, lNoCycles(i)) = dWorkPeaks(1, lWorkPos - 1)
dFromToRain(i, 2, lNoCycles(i)) = dWorkPeaks(1, lWorkPos - 0)
dFromToRain(i, 3, lNoCycles(i)) = dWorkPeaks(0, lWorkPos - 2)
dFromToRain(i, 4, lNoCycles(i)) = dWorkPeaks(0, lWorkPos - 1)
dWorkPeaks(0, lWorkPos - 2) = dWorkPeaks(0, lWorkPos)
dWorkPeaks(1, lWorkPos - 2) = dWorkPeaks(1, lWorkPos)
lWorkPos = lWorkPos - 2
Else
lWorkPos = lWorkPos + 1
lPeakPos = lPeakPos + 1
dWorkPeaks(0, lWorkPos) = dPeaks(i, 0, lPeakPos)
dWorkPeaks(1, lWorkPos) = lPeakPos
End If
Loop
Next i
End Sub