libdatascheck.bas

本系统是给大庆油田做的一个示例程序

Attribute VB_Name = "LibDatasCheck"
Option Explicit

Sub Hmove_Check(lpump As Single, hmove As Single, nw As Single, pcase As Single, Lz As Single, pr_well As Single)
    Dim ps As Single, swo As Single, deltp As Single, pf As Single
    Dim swater As Single, soil As Single
    Dim SCrudeOil As Single
    
    Call PsCal(nw, lpump, hmove, pcase, SCrudeOil, ps)
    
    swater = 1000
    soil = SCrudeOil
    swo = nw * swater + (1 - nw) * soil
   
    deltp = (Lz - lpump) * swo * 9.81
    pf = ps + deltp
    
    DataErr4 = 1
    DataErr5 = 1
    If ps <= 100000# Then
         MsgBox "动液面已经低于泵的吸入口，请校核动液面与泵深！", vbInformation, "提醒"
         DataErr4 = 0
         Exit Sub
    End If
    
    If pf >= pr_well Then
         MsgBox "流压已经高于静压，请校核动液面、泵深与静压！", vbInformation, "提醒"
         DataErr5 = 0
         Exit Sub
    End If
End Sub

Sub WellDatas_Check(Lz As Single, pr_well As Single, pb_well As Single, SCrudeOil As Single, mu As Single, nw As Single, _
            sp As Single, TSurface As Single, dTPer100m As Single, Spr_use As Single, rpm As Single, _
            dpump As Single, lpump As Single, hmove As Single, poil As Single, pcase As Single, _
            dtubei As Single, s0 As Single, nrod As Integer, drod() As Single, lrod() As Single, _
            tanchor As String, WellDataErrS() As Integer)
            
    Dim i As Integer
    
    For i = 1 To 16
        WellDataErrS(i) = 1
    Next i
    
    If Spr_use = 0 Then
         MsgBox "冲程长度值不允许缺省，请输入冲程长度！", vbInformation, "提醒"
         WellDataErrS(1) = 0
         Exit Sub
    End If
    
    If rpm = 0 Then
         MsgBox "冲次值不允许缺省，请输入冲程次数！", vbInformation, "提醒"
         WellDataErrS(2) = 0
         Exit Sub
    End If
    
    If dpump = 0 Then
         MsgBox "泵径值不允许缺省，请输入泵径！", vbInformation, "提醒"
         WellDataErrS(3) = 0
         Exit Sub
    End If
    
    If lpump = 0 Then
         MsgBox "下泵深度值不允许缺省，请输入下泵深度！", vbInformation, "提醒"
         WellDataErrS(4) = 0
         Exit Sub
    End If
    
    If dtubei = 0 Then
         MsgBox "油管内径值不允许缺省，请输入油管内径！", vbInformation, "提醒"
         WellDataErrS(5) = 0
         Exit Sub
    End If
    
    If mu = 0 Then
         MsgBox "原油粘度值不允许缺省，原油粘度！", vbInformation, "提醒"
         WellDataErrS(6) = 0
         Exit Sub
    End If
    
    If TSurface = 0 Then
         MsgBox "地面常温层温度不允许缺省，请输入地面常温层温度！", vbInformation, "提醒"
         WellDataErrS(7) = 0
         Exit Sub
    End If
    
    If TSurface <= 5 Or TSurface >= 50 Then
         MsgBox "地面常温层温度一般为25℃左右，请校核并修改地面常温层温度！", vbInformation, "提醒"
         WellDataErrS(8) = 0
         Exit Sub
    End If
    
    If dTPer100m = 0 Then
         MsgBox "地层温度梯度不允许缺省，请输入地层温度梯度！", vbInformation, "提醒"
         WellDataErrS(9) = 0
         Exit Sub
    End If
    
    If (dTPer100m <= 0.4 And dTPer100m > 0) Or dTPer100m >= 10 Then
         MsgBox "地层温度梯度一般为2～5℃，请校核并修改地层温度梯度！", vbInformation, "提醒"
         WellDataErrS(10) = 0
         Exit Sub
    End If
    
    If nrod = 0 Then
         MsgBox "抽油杆级数不能为零，请校核并修改抽油杆级数！", vbInformation, "提醒"
         WellDataErrS(11) = 0
         Exit Sub
    End If
    
    For i = 1 To nrod
        If drod(i) = 0 Then
             MsgBox "抽油杆直径不能为零，请校核并修改抽油杆直径！", vbInformation, "提醒"
             WellDataErrS(12) = 0
             Exit Sub
        End If
    Next i
    
    For i = 1 To nrod
        If lrod(i) = 0 Then
             MsgBox "抽油杆长度不能为零，请校核并修改抽油杆长度！", vbInformation, "提醒"
             WellDataErrS(13) = 0
             Exit Sub
        End If
    Next i
    
    If SCrudeOil = 0 Then
         MsgBox "原油密度不能为零，请校核并修改原油密度！", vbInformation, "提醒"
         WellDataErrS(14) = 0
         Exit Sub
    End If
    
    If SCrudeOil > 0 And SCrudeOil < 700 Then
         MsgBox "原油密度单位10^3kg/m^3(公斤/方)，一般为860公斤/方，请校核并修改原油密度！", vbInformation, "提醒"
         WellDataErrS(15) = 0
         Exit Sub
    End If
    
    If nw < 0 Or nw > 100 Then
         MsgBox "含水率应为0～100%，请校核并修改含水率！", vbInformation, "提醒"
         WellDataErrS(16) = 0
         Exit Sub
    End If
End Sub

Sub DynyCards_Check(spr_card As Single, rpm_card As Single, Ncal_MeasuringPoint As Integer, _
                    Pr_Card() As Single, Prl_Card() As Single, DynyDataErrS() As Integer)
    Dim i As Integer, ISum As Integer
    Dim sum As Single
    
    For i = 1 To 5
        DynyDataErrS(i) = 1
    Next i
    
    If spr_card <= 0.1 Then
         MsgBox "冲程长度不可能为0，请校核测试数据！", vbInformation, "提醒"
         DynyDataErrS(1) = 0
         Exit Sub
    End If
    
    If rpm_card <= 0.1 Then
         MsgBox "冲次不可能为0，请校核测试数据！", vbInformation, "提醒"
         DynyDataErrS(2) = 0
         Exit Sub
    End If
    
    If Ncal_MeasuringPoint <= 10 Then
         MsgBox "测试点数太少，请校核测试数据！", vbInformation, "提醒"
         DynyDataErrS(3) = 0
         Exit Sub
    End If
    
    sum = 0
    For i = 1 To Ncal_MeasuringPoint
        sum = sum + Pr_Card(i)
    Next i
    If sum <= 0.1 Then
         MsgBox "缺少位移测试数据，请校核测试数据！", vbInformation, "提醒"
         DynyDataErrS(4) = 0
         Exit Sub
    End If
    
    sum = 0
    For i = 1 To Ncal_MeasuringPoint
        sum = sum + Prl_Card(i)
    Next i
    If sum <= 0.1 Then
         MsgBox "缺少载荷测试数据，请校核测试数据！", vbInformation, "提醒"
         DynyDataErrS(5) = 0
         Exit Sub
    End If
End Sub