adjust.bas

三角形闭合差计算程序

               If TD > 2 * g_Pi Then TD = TD - 2 * g_Pi
               If TD > 2 * g_Pi Then TD = TD - 2 * g_Pi
               X0(CC(I)) = X0(BB(I)) + Sbc * Cos(TD)
               Y0(CC(I)) = Y0(BB(I)) + Sbc * Sin(TD)
        Next I
End Sub

      
Sub InvSqr1()
        Dim Ss As Double
        Dim Zt As Long
        Dim Zt1 As Long
        Zt = 2 * g_Ed
        Zt1 = Zt
        For I = 1 To N - Zt
             W(I) = W(Zt + I)
        Next I
        For I = 1 To (N - Zt) * (N - Zt + 1) / 2
            C(I) = C(Zt * N - (Zt - 1) * Zt / 2 + I)
        Next I
        N = N - Zt
        For I = 1 To N
             DI = (I - 1) * (N - I / 2#)
             For j = I To N
                     Ss = C(DI + j)
                     For k = 1 To I - 1
                             dk = (k - 1) * (N - k / 2#)
                             Ss = Ss - C(dk + I) * C(dk + j) / C(dk + k)
                     Next k
                     If j = I Then
                          C(DI + j) = 1 / Ss
                     Else
                          C(DI + j) = Ss * C(DI + I)
                     End If
             Next j
        Next I
        For I = 1 To N - 1
             DI = (I - 1) * (N - I / 2#)
             For j = I + 1 To N
                 Ss = -C(DI + j)
                 For k = I + 1 To j - 1
                        dk = (k - 1) * (N - k / 2#)
                        Ss = Ss - C(DI + k) * C(dk + j)
                 Next k
                 C(DI + j) = Ss
             Next j
        Next I
        For I = 1 To N - 1
             DI = (I - 1) * (N - I / 2#)
             For j = I To N
                     DJ = (j - 1) * (N - j / 2#)
                     If (I = j) Then
                          Ss = C(DI + j)
                     Else
                          Ss = C(DI + j) * C(DJ + j)
                     End If
                     For k = j + 1 To N
                            dk = (k - 1) * (N - k / 2#)
                            Ss = Ss + C(DI + k) * C(DJ + k) * C(dk + k)
                     Next k
                     C(DI + j) = Ss
             Next j
        Next I
End Sub


Sub ObNorS()
   Dim A(500) As Double
   Dim Dx As Double
   Dim Dy As Double
   Dim DZ As Double
   Dim t As Double
   Dim t1 As Double
   Dim t2 As Double
   Dim T3 As Double
   Dim T4 As Double
   Dim Ss As Double
   Dim Zt As Long
   For I = 1 To g_M1
        Dx = X0(D(I)) - X0(E(I))
        Dy = Y0(D(I)) - Y0(E(I))
        Ss = Sqr(Dx * Dx + Dy * Dy)
        A(N + 1) = 1000# * (Ss - Sid(I))
        L1(I) = A(N + 1)
        JJ(1) = 2 * E(I) - 1
        JJ(2) = 2 * E(I)
        JJ(3) = 2 * D(I) - 1
        JJ(4) = 2 * D(I)
         A(JJ(1)) = -Dx / Ss
        A(JJ(2)) = -Dy / Ss
        A(JJ(3)) = -A(JJ(1))
        A(JJ(4)) = -A(JJ(2))
        If g_Km = 1 Then A(JJ(5)) = -Sid(I) / 1000
        Zt = 4
        If E(I) > D(I) Then
            For j = 1 To 2
                 k = JJ(j)
                JJ(j) = JJ(j + 2)
                JJ(j + 2) = k
           Next j
        End If
        For j = 1 To Zt
            A1(I, j) = A(JJ(j))
            B1(I, j) = JJ(j)
        Next j
        Ps(I) = Psk(I) * M02(5) ^ 2 / (g_Ms + Ss * g_Pp * 0.001) ^ 2
        For j = 1 To Zt
            DI = (JJ(j) - 1) * (N - JJ(j) / 2#)
            For k = j To Zt
                t = Ps(I) * A(JJ(j)) * A(JJ(k))
                C(DI + JJ(k)) = C(DI + JJ(k)) + t
             Next k
             W(JJ(j)) = W(JJ(j)) + Ps(I) * A(JJ(j)) * A(N + 1)
         Next j
         Pll = Pll + Ps(I) * A(N + 1) * A(N + 1)
    Next I
End Sub


Sub ObNorD()
    Dim A(500) As Double
    Dim h As Long
    Dim Dx As Double
    Dim Dy As Double
     Dim A0 As Double
     Dim Isd As Integer
        For h = 1 To g_ST
            ZZ0 = 0#
            For I = g_Si(h) To g_Si(h) + NI(h) - 1
                Zt = 0
                Dx = X0(F(I)) - X0(G(I))
                Dy = Y0(F(I)) - Y0(G(I))
                s = Dx * Dx + Dy * Dy
                AI = -Dy / s * L0
                BI = Dx / s * L0
                Call ALFA(Dx, Dy, A0)
                If I = g_Si(h) Then ZZ0 = A0 - g_Dir(I)
                Ss = A0 - ZZ0 - g_Dir(I)
                If Abs(Ss) > g_Pi Then Ss = Ss + 2# * g_Pi
                A(N + 1) = Ss * L0 * 1000#
                L2(I) = A(N + 1)
                JJ(1) = 2 * G(I) - 1
                JJ(3) = 2 * F(I) - 1
                JJ(2) = JJ(1) + 1
                JJ(4) = JJ(3) + 1
                Isd = 2 * (g_Ed + g_Dd)
                A(JJ(1)) = -AI
                A(JJ(2)) = -BI
                A(JJ(3)) = AI
                A(JJ(4)) = BI
                JJ(5) = Isd + h
                A(JJ(5)) = -1#
                Zt = 5
                If (G(I) > F(I)) Then
                        k = JJ(1)
                        JJ(1) = JJ(3)
                        JJ(3) = k
                        k = JJ(2)
                        JJ(2) = JJ(4)
                        JJ(4) = k
                End If
                For j = 1 To Zt
                      A2(I, j) = A(JJ(j))
                      B2(I, j) = JJ(j)
                Next j
                For j = 1 To Zt
                    DI = (JJ(j) - 1) * (N - JJ(j) / 2#)
                    For k = j To Zt
                         t = A(JJ(j)) * A(JJ(k))
                         C(DI + JJ(k)) = C(DI + JJ(k)) + t
                     Next k
                     W(JJ(j)) = W(JJ(j)) + A(JJ(j)) * A(N + 1)
                 Next j
                 Pll = Pll + A(N + 1) * A(N + 1)
             Next I
         Next h
End Sub

 Sub BardSno()
        Dim Zt As Long
        Dim ZT2 As Long
        Dim h As Long
        Dim QLL(g_MaxObsNum) As Double
        Dim PQVV(g_MaxObsNum) As Double
        Dim PQ(4) As Double
        Dim PVVI(4) As Double
        Dim WA As Double
        Dim t As Double
        Dim t1 As Double
        Dim t2 As Double
        Dim T3 As Double
        Dim T4 As Double
        Dim T5 As Double
        Dim AA(2, 3) As Double
        ZT2 = 0
        For I = 1 To 2
              PVVI(I) = 0#
              PQ(I) = 0#
        Next I
        If (g_M1 > 0) Then
               Zt = 4
               For I = 1 To g_M1
                    V1(I) = L1(I)
                    For j = 1 To Zt
                          V1(I) = V1(I) + A1(I, j) * DXYZ(B1(I, j))
                    Next j
                    PVVI(1) = PVVI(1) + V1(I) * V1(I) * Ps(I)
               Next I
               For I = 1 To g_M1
                    QLL(I) = 0#
                    For j = 1 To Zt
                        t = 0#
                        DJ = (B1(I, j) - 1) * (N - B1(I, j) / 2#)
                        For k = 1 To Zt
                            dk = (B1(I, k) - 1) * (N - B1(I, k) / 2#)
                            If (B1(I, k) >= B1(I, j)) Then
                                 t = t + A1(I, k) * C(DJ + B1(I, k))
                            Else
                                 t = t + A1(I, k) * C(dk + B1(I, j))
                            End If
                        Next k
                        QLL(I) = QLL(I) + t * A1(I, j)
                    Next j
               Next I
        
               For I = 1 To g_M1
                    PQVV(I) = Ps(I) * (1# / Ps(I) - QLL(I))
                    PQ(1) = PQ(1) + PQVV(I)
               Next I
              Set arecord = g_d_Base.OpenRecordset("AdjustmentBasicInformationTable", dbOpenTable)
               With arecord
                   .MoveFirst
                   .Edit
                   .Fields(19) = Int(PQ(1) * 100# + 0.5) / 100#
                   .Fields(20) = Int(PQ(1) / g_M1 * 100# + 0.5) / 100#
                   .Update
               End With
               arecord.Close
               Set arecord = g_d_Base.OpenRecordset("DistanceAdjustedResultTable", dbOpenTable)
                With arecord
                       ic = .RecordCount
                        If .RecordCount > 0 Then
                               .MoveFirst
                               For I = 1 To ic
                                     .Delete
                                     If I < ic Then
                                         .MoveFirst
                                     End If
                                Next I
                        End If
                     For I = 1 To g_M1
                       If (PQVV(I) < 0.00001) Then
                             WA = 0
                       Else
                             t = Sqr(PQVV(I) / Ps(I)) * UW
                             WA = V1(I) / t
                       End If
                       If Abs(WA) > Ka Then
                             MsgBox "Distance Observation Value from " + Trim(g_PN(E(I))) + " To " + Trim(g_PN(D(I))) + " Maybe contain Gross Error !", , "Information"
                             ZT2 = ZT2 + 1
                       End If
                       t1 = V1(I)
                       t2 = Sid(I) + t1 / 1000
                       T3 = UW * Sqr(QLL(I))
                       If (YU = 1) Then
                           Sid(I) = 0#
                           t1 = 0#
                           t2 = 0#
                           WA = 0#
                       End If
                       .AddNew
                       .Fields(0) = I
                       .Fields(1) = E1(I)
                       .Fields(2) = D1(I)
                       .Fields(3) = Int(Sid(I) * 100000# + 0.5) / 100000#
                       .Fields(4) = Int(t1 * 100 + 0.5) / 100#
                       .Fields(5) = Int(t2 * 100000# + 0.5) / 100000#
                       .Fields(6) = Int(T3 * 100# + 0.5) / 100#
                       .Fields(7) = Int(PQVV(I) * 100 + 0.5) / 100#
                       .Fields(8) = Int(Abs(WA) * 100# + 0.5) / 100#
                       .Update
                   Next I
              End With
            arecord.Close
        End If
        If g_M2 > 0 Then
               Zt = 5
               For I = 1 To g_M2
                    V2(I) = L2(I)
                    For j = 1 To Zt
                        If (B2(I, j) = 0) Then GoTo L
                        V2(I) = V2(I) + A2(I, j) * DXYZ(B2(I, j))
                    Next j
L:
                    PVVI(2) = PVVI(2) + V2(I) ^ 2
               Next I
               For h = 1 To g_ST
                    For I = g_Si(h) To g_Si(h) + NI(h) - 1
                        If I = g_Si(h) Then T4 = V2(I)
                        g_Dir1(I) = g_Dir(I) + (V2(I) - T4) / (L0 * 1000#)
                    Next I
               Next h
               For I = 1 To g_M2
                    QLL(I) = 0#
                    For j = 1 To Zt
                        t = 0#
                        If (B2(I, j) = 0) Then GoTo lll
                        DJ = (B2(I, j) - 1) * (N - B2(I, j) / 2#)
                        For k = 1 To Zt
                            If (B2(I, k) = 0) Then GoTo LL
                            dk = (B2(I, k) - 1) * (N - B2(I, k) / 2#)
                            If (B2(I, k) >= B2(I, j)) Then
                                t = t + A2(I, k) * C(DJ + B2(I, k))
                            Else
                                t = t + A2(I, k) * C(dk + B2(I, j))
                            End If
LL:
                        Next k
                        QLL(I) = QLL(I) + t * A2(I, j)
lll:
                    Next j
               Next I
               For I = 1 To g_M2
                    PQVV(I) = 1# - QLL(I)
                    PQ(2) = PQ(2) + PQVV(I)