libcardtreat.bas

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

Attribute VB_Name = "LibCardTreat"
Option Explicit
Rem  实测示功图数据扩展
Sub DataTreatd_Card(Ncal_Card As Integer, t_timex() As Single, pr() As Single, prl() As Single, _
                     Ncal As Integer, t_time() As Single)
                   
    
    Dim j As Integer, M As Integer, n As Integer
    Dim x(1500) As Single, Y(1500) As Single
    Dim F(1500) As Single, F1(1500) As Single, F2(1500) As Single, T(1500) As Single
    
    n = Ncal_Card
    M = Ncal
    
    For j = 1 To n
        x(j) = t_timex(j)
        Y(j) = pr(j)
    Next j

    For j = 1 To M
        T(j) = t_time(j)
    Next j

    Call ChZh(n, x, Y, M, T, F, F1, F2)
    
    For j = 1 To Ncal
        pr(j) = F(j)
    Next j
    
    For j = 1 To n
        x(j) = t_timex(j)
        Y(j) = prl(j)
    Next j

    For j = 1 To M
        T(j) = t_time(j)
    Next j

    Call ChZh(n, x, Y, M, T, F, F1, F2)
    
    For j = 1 To Ncal
        prl(j) = F(j)
    Next j
End Sub

Rem  悬点示功图的规则化(悬点最大载荷、最大位移均为1。载荷除以最大载荷，位移除以最大最小位移的差值)
Sub PrlCardNormalized(Ncal As Integer, Pr_Card() As Single, Prl_Card() As Single, _
                     UnitPr_Card() As Single, UnitPrl_Card() As Single, WrBar As Single, UnitWrBar As Single)
    
    Dim PrlMax As Single, PrlMin As Single, prMin As Single, prMax As Single
    Dim j As Integer
    
    prMin = 10
    prMax = 0
    PrlMin = 100000#
    PrlMax = 0
    
    For j = 1 To Ncal
        If Pr_Card(j) <= prMin Then prMin = Pr_Card(j)
        If Pr_Card(j) >= prMax Then prMax = Pr_Card(j)
        If Prl_Card(j) <= PrlMin Then PrlMin = Prl_Card(j)
        If Prl_Card(j) >= PrlMax Then PrlMax = Prl_Card(j)
    Next j
    
    For j = 1 To Ncal
        UnitPr_Card(j) = (Pr_Card(j) - prMin) / (prMax - prMin)
        UnitPrl_Card(j) = Prl_Card(j) / PrlMax
    Next j
    UnitWrBar = WrBar / PrlMax
End Sub
Rem 泵示功图的规则化
Sub PumpCardNormalized(Ncal As Integer, XPump() As Single, PPump() As Single, _
                       UnitXPump() As Single, UnitPPump() As Single)
    
    Dim XPumpMin As Single, XPumpMax As Single, PPumpMax As Single, PPumpMin As Single
    Dim j As Integer
    
    XPumpMin = XPump(1)
    XPumpMax = XPump(1)
    PPumpMax = PPump(1)
    PPumpMin = PPump(1)
   
    For j = 1 To Ncal
        If XPump(j) < XPumpMin Then XPumpMin = XPump(j)
        If XPump(j) > XPumpMax Then XPumpMax = XPump(j)
        If PPump(j) >= PPumpMax Then PPumpMax = PPump(j)
        If PPump(j) <= PPumpMin Then PPumpMin = PPump(j)
    Next j

    For j = 1 To Ncal
        UnitXPump(j) = (XPump(j) - XPumpMin) / (XPumpMax - XPumpMin)
        UnitPPump(j) = (PPump(j) - PPumpMin) / (PPumpMax - PPumpMin)
    Next j
End Sub


Rem 均匀采样后的载荷，1、2阶导数
Sub PumpCard_EqualSampling(JCal As Integer, Ncal As Integer, UnitXPump() As Single, UnitPPump() As Single, _
                            F1() As Single, F2() As Single)
    
    Dim j As Integer
    
    Dim M As Integer, n As Integer
    Dim x(1500) As Single, Y(1500) As Single, T(1500) As Single
    Dim F(1500) As Single
    
    n = Ncal
    M = JCal
    For j = 1 To n
        x(j) = UnitXPump(j)
        Y(j) = UnitPPump(j)
    Next j
    
    For j = 1 To M
         T(j) = 1 / (M - 1) * (j - 1)
    Next j
    
    Call ChZh(n, x, Y, M, T, F, F1, F2)
   
    For j = 1 To M
        UnitXPump(j) = T(j)
        UnitPPump(j) = F(j)
        If F1(j) >= 4.5 Then F1(j) = 4.5
        If F1(j) <= -4.5 Then F1(j) = -4.5
        If F2(j) >= 4.5 Then F2(j) = 4.5
        If F2(j) <= -4.5 Then F2(j) = -4.5
    Next j
End Sub

Rem 根据位移测试数据，求悬点速度
Sub Vpr_Cal(Ncal As Integer, t_time() As Single, Pr_Card() As Single, vpr() As Single)
    
    Dim j As Integer
    Dim M As Integer, n As Integer
    Dim x(1500) As Single, Y(1500) As Single, T(1500) As Single
    Dim F(1500) As Single, F1(1500) As Single, F2(1500) As Single
    
    n = Ncal
    M = Ncal
    For j = 1 To Ncal
        x(j) = t_time(j)
        Y(j) = Pr_Card(j)
        T(j) = x(j)
    Next j
    
    Call ChZh(Ncal, x, Y, Ncal, T, F, F1, F2)
    
    For j = 1 To Ncal
        vpr(j) = F1(j)
    Next j
End Sub