Public Sub GradationSave '***************************************************** '26Aug2014 sc 'Description: ' 1. Checks that percent finer values are decreasing with ' decreasing particle size. ' 2. Determines the percent passing the 0.425mm size from ' the particle size distribution data and stores the ' value in the LLIN, LLPL, LSLT, and LSTG tables. ' 3. Calculate the % Cobbles, etc. and stores the values ' in the parent (GRAG) table. ' This procedure must be called from the child table, ' not the parent table. The calculations must be done ' in the child even though the result is stored in the parent. '***************************************************** Const i_Col_Passing As Integer = 2 Const i_Col_Size As Integer = 1 Const s_Field_Passing As String = "GRAT_PERP" Const s_Field_Size As String = "Reading" Dim dDataA() As Double Dim dPassing As Double Dim dPassingPrev As Double Dim iPsSize As Integer Dim iPsPassing As Integer Dim lRow As Long '----------------------- 'If there are no sieve data, do nothing. If glNumRows = 0 Then Exit Sub End If 'Obtain pointers to the field data within the data array. If InitFieldsFnB(s_Field_Size, iPsSize, _ s_Field_Passing, iPsPassing) _ Then 'One or more of the required fields missing from the table. Exit Sub End If 'Create a double precision array to hold the particle size 'and percent passing data. This will be in row,column order 'instead of the column,row structure of gsDataA. This is a 'more intuitive order. gsDataA must be in column,row order 'because it is ReDim'd with preservation of data when the number 'of rows are changed and only the last dimension can be changed 'in this case. ReDim dDataA(glNumRows, 2) dPassingPrev = 100 For lRow = 1 To glNumRows dPassing = CDbl(gsDataA(iPsPassing, lRow)) If dPassing > dPassingPrev Then With gINTRules .GridData.ErrorCol = iPsPassing .GridData.ErrorRow = lRow .ErrorMessage = "Finer values must decrease with decreasing particle size" End With Exit Sub End If dDataA(lRow, i_Col_Size) = CDbl(gsDataA(iPsSize, lRow)) dDataA(lRow, i_Col_Passing) = dPassing dPassingPrev = dPassing Next lRow 'Update the soil fractions (cobbles, gravels,etc.) in the parent table. Const s_Field_Cobbles As String = "GRAG_VCRE" Const s_Field_Gravel As String = "GRAG_GRAV" Const s_Field_Sand As String = "GRAG_SAND" Const s_Field_Silt As String = "GRAG_SILT" Const s_Field_Clay As String = "GRAG_CLAY" Const s_Field_Fines As String = "GRAG_FINE" 'Hidden, non-AGS fields used by code to copy these values to other tables. Const s_Field_00425 As String = "GRAG_425" '0.425mm %passing Const s_Field_02000 As String = "GRAG_020" '2mm %retained Const s_Field_06300 As String = "GRAG_063" '6.3mm %retained Const s_Field_20000 As String = "GRAG_200" '20mm %retained Const s_Field_37500 As String = "GRAG_375" '37.5mm %retained Dim sPP00002 As String '0.002mm Dim sPP00600 As String '0.06mm '20160408 daa TFS 406275 was 0.063mm Dim sPP02000 As String '2mm Dim sPP00425 As String '0.425mm Dim sPP06300 As String '6.3mm Dim sPP20000 As String '20mm Dim sPP37500 As String '37.5mm Dim sPP60000 As String '60mm '20160408 daa TFS 406275 was 63mm '--------------------- sPP60000 = DeterminePercentPassingFnS(dDataA(), 60) '20160408 daa TFS 406275 was 63mm sPP37500 = DeterminePercentPassingFnS(dDataA(), 37.5) sPP20000 = DeterminePercentPassingFnS(dDataA(), 20) sPP06300 = DeterminePercentPassingFnS(dDataA(), 6.3) sPP02000 = DeterminePercentPassingFnS(dDataA(), 2) sPP00425 = DeterminePercentPassingFnS(dDataA(), 0.425) sPP00600 = DeterminePercentPassingFnS(dDataA(), 0.06) '20160408 daa TFS 406275 was 0.063mm sPP00002 = DeterminePercentPassingFnS(dDataA(), 0.002) With gINTRules.GridData.ParentRecord .Edit .Fields(s_Field_Cobbles) = Null .Fields(s_Field_Gravel) = Null .Fields(s_Field_Sand) = Null .Fields(s_Field_Silt) = Null .Fields(s_Field_Clay) = Null .Fields(s_Field_Fines) = Null .Fields(s_Field_37500) = Null .Fields(s_Field_20000) = Null .Fields(s_Field_06300) = Null .Fields(s_Field_02000) = Null .Fields(s_Field_00425) = Null If IsNumeric(sPP60000) Then .Fields(s_Field_Cobbles) = 100 - CDbl(sPP60000) End If If IsNumeric(sPP37500) Then sPP37500 = CStr(100 - CDbl(sPP37500)) .Fields(s_Field_37500) = sPP37500 End If If IsNumeric(sPP20000) Then sPP20000 = CStr(100 - CDbl(sPP20000)) .Fields(s_Field_20000) = sPP20000 End If If IsNumeric(sPP02000) Then .Fields(s_Field_02000) = 100 - CDbl(sPP02000) If IsNumeric(sPP60000) Then .Fields(s_Field_Gravel) = CDbl(sPP60000) - CDbl(sPP02000) End If End If If IsNumeric(sPP06300) Then sPP06300 = CStr(100 - CDbl(sPP06300)) .Fields(s_Field_06300) = sPP06300 End If If IsNumeric(sPP00600) Then .Fields(s_Field_Fines) = CDbl(sPP00600) If IsNumeric(sPP02000) Then .Fields(s_Field_Sand) = CDbl(sPP02000) - CDbl(sPP00600) End If End If If IsNumeric(sPP02000) Then sPP02000 = CStr(100 - CDbl(sPP02000)) End If If IsNumeric(sPP00002) Then If IsNumeric(sPP00600) Then .Fields(s_Field_Silt) = CDbl(sPP00600) - CDbl(sPP00002) End If .Fields(s_Field_Clay) = CDbl(sPP00002) End If If IsNumeric(sPP00425) Then .Fields(s_Field_00425) = CDbl(sPP00425) End If .Update End With 'Update the fields containing %passing/retained values. Call PercentPassingRetainedAssign(1, miPP425, sPP00425) Call PercentPassingRetainedAssign(1, miPR020, sPP02000) Call PercentPassingRetainedAssign(1, miPR063, sPP06300) Call PercentPassingRetainedAssign(1, miPR200, sPP20000) Call PercentPassingRetainedAssign(1, miPR375, sPP37500) gINTRules.GridData.RefreshParent = True End Sub