datdsp.bas

通过GPIB接口读取频谱仪的测试曲线

  PDRAW LftX, BtmY
End Sub
'
Sub CALDIRCOE(D)
'  SHARED Lvl%(), MaxLvl%, CenAgl&, CT%, MaxAgl&
  CT% = -1: D = NoLvl
  CrntRgtAgl& = CenAgl&
  CrntLftAgl& = CenAgl&
  RANGLE# = 360 / (MaxAgl& + 1)
  sMaxLvl = MaxLvl% / 100
  AC# = 0.017453293 * RANGLE#
  L& = 0
  While Lvl%(CrntRgtAgl&) = NoLvl
    CrntRgtAgl& = IncAgl&(CrntRgtAgl&)
    L& = L& + 1
    If L& > MaxAgl& Then GoTo ExitSub
  Wend
  L& = 0
  While Lvl%(CrntLftAgl&) = NoLvl
    CrntLftAgl& = DecAgl&(CrntLftAgl&)
    L& = L& + 1
    If L& > MaxAgl& Then GoTo ExitSub
  Wend
  PreRgtAgl& = CrntRgtAgl&
  PreLftAgl& = CrntLftAgl&
  DL# = 0: DR# = 0
  For I& = 0 To MaxAgl& / 2
     CrntRgtAgl& = IncAgl&(CrntRgtAgl&)
    If Lvl%(CrntRgtAgl&) <> NoLvl Then
      AI& = CrntRgtAgl& - PreRgtAgl&: If AI& < 0 Then AI& = AI& + MaxAgl&
      f2# = (Lvl%(CrntRgtAgl&) + Lvl%(PreRgtAgl&)) / 200 - sMaxLvl
      DR# = DR# + EXP10(0.1 * f2#) * Sin((I& - AI& / 2) * AC#) * AI& * AC#
      PreRgtAgl& = CrntRgtAgl&
    End If

    CrntLftAgl& = DecAgl&(CrntLftAgl&)
    If Lvl%(CrntLftAgl&) <> NoLvl Then
      AI& = PreLftAgl& - CrntLftAgl&: If AI& < 0 Then AI& = AI& + MaxAgl&
      f2# = (Lvl%(CrntLftAgl&) + Lvl%(PreLftAgl&)) / 200 - sMaxLvl
      DL# = DL# + EXP10(0.1 * f2#) * Sin((I& - AI& / 2) * AC#) * AI& * AC#
      PreLftAgl& = CrntLftAgl&
    End If
  Next I&
  On Local Error GoTo ExitSub
  D = 6.0206 - 10 * LOG10(DL# + DR#)
  On Error GoTo 0
ddd:
  Exit Sub
ExitSub:
  CT% = 0
  Resume ddd
End Sub

Sub CALGAIN(Gain)
'  SHARED Lvl%(), MaxLvl%, CenAgl&, CT%, MaxAgl&
  ReDim Xi(-2 To 3), Yi(-2 To 3) As Long

  CT% = -1: Gain = NoLvl
  RANGLE# = 360 / (MaxAgl& + 1)
  AC# = 0.017453293 * RANGLE#
  CrntAgl& = CenAgl&
'  GOTO lpp
'Config center point
  L& = 0
  For I& = 0 To -2 Step -1
    Do
      CrntAgl& = DecAgl&(CrntAgl&)
      L& = L& - 1
      If Abs(L&) > MaxAgl& Then GoTo ExitSubb
    Loop Until Lvl%(CrntAgl&) <> NoLvl
    Xi(I&) = L&
    Yi(I&) = Lvl%(CrntAgl&)
  Next I&

  L& = 0
  CrntAgl& = CenAgl&
  For I& = 1 To 3
    Do
      CrntAgl& = IncAgl&(CrntAgl&)
      L& = L& + 1
      If L& > MaxAgl& Then GoTo ExitSubb
    Loop Until Lvl%(CrntAgl&) <> NoLvl
    Xi(I&) = L&
    Yi(I&) = Lvl%(CrntAgl&)
  Next I&
  GoSub GetCenY
  Lvl%(CenAgl&) = K0
  Erase Xi, Yi

  If Lvl%(CenAgl&) > MaxLvl% Then MaxLvl% = Lvl%(CenAgl&)
'lpp:

  ReDim Xi(0 To 2), Yi(0 To 2) As Long
  DR# = 0
  CrntAgl& = DecAgl&(CenAgl&)
  I& = -1
  Do
   For J% = 0 To 2
     Do
       CrntAgl& = IncAgl&(CrntAgl&)
       I& = I& + 1
       If I& > MaxAgl& Then GoTo ExitSubb
     Loop Until Lvl%(CrntAgl&) <> NoLvl
     Xi(J%) = I&
     Yi(J%) = Lvl%(CrntAgl&)
   Next J%
   If I& < (MaxAgl& + 1) / 2 Then
     xu# = AC# * Xi(2)
     GoSub CalLoc
     DR# = DR# + LR#
   Else
    xu# = AC# * (MaxAgl& + 1) / 2
     GoSub CalLoc
     DR# = DR# + LR#
     Exit Do
   End If
   I& = I& - 1
   CrntAgl& = DecAgl&(CrntAgl&)
  Loop Until I& >= MaxAgl&

  DL# = 0
  CrntAgl& = IncAgl&(CenAgl&)
  I& = -1
  Do
   For J% = 0 To 2
     Do
       CrntAgl& = DecAgl&(CrntAgl&)
       I& = I& + 1
       If I& > MaxAgl& Then GoTo ExitSubb
     Loop Until Lvl%(CrntAgl&) <> NoLvl
     Xi(J%) = I&
     Yi(J%) = Lvl%(CrntAgl&)
   Next J%
   If I& < (MaxAgl& + 1) / 2 Then
     xu# = AC# * Xi(2)
     GoSub CalLoc
     DL# = DL# + LR#
   Else
     xu# = AC# * (MaxAgl& + 1) / 2
     GoSub CalLoc
     DL# = DL# + LR#
     Exit Do
   End If

   I& = I& - 1
   CrntAgl& = IncAgl&(CrntAgl&)
  Loop Until I& >= MaxAgl&
  Erase Xi, Yi

  On Local Error GoTo ExitSubb
  Gain = 6.0206 - 10 * LOG10(DL# + DR#)
'  PRINT Gain
  On Error GoTo 0
ddde:
  Exit Sub
ExitSubb:
  CT% = 0
  Resume ddde


CalLoc:
    x0# = Xi(0) * AC#: X1# = Xi(1) * AC#: X2# = Xi(2) * AC#
    y0# = EXP10((Yi(0) - MaxLvl%) / 1000) * Sin(x0#)
    Y1# = EXP10((Yi(1) - MaxLvl%) / 1000) * Sin(X1#)
    Y2# = EXP10((Yi(2) - MaxLvl%) / 1000) * Sin(X2#)
    f0# = y0#: f1# = (Y1# - y0#) / (X1# - x0#)
    f2# = ((Y2# - y0#) / (X2# - x0#) - (Y1# - y0#) / (X1# - x0#)) / (X2# - X1#)
    A0# = f0# - f1# * x0# + f2# * x0# * X1#
    A1# = 0.5 * (f1# - f2# * (x0# + X1#))
    A2# = f2# / 3
    LR# = A0# * (xu# - x0#) + A1# * (xu# * xu# - x0# * x0#) + A2# * (xu# ^ 3 - x0# ^ 3)
  Return

GetCenY:
  C0 = 6: C1 = 0: C2 = 0: C3 = 0: C4 = 0: D0 = 0: D1 = 0: D2 = 0

  For I& = -2 To 3
    XX = Xi(I&): YY = Yi(I&)
    C1 = C1 + XX
    C2 = C2 + XX * XX
    C3 = C3 + XX * XX * XX
    C4 = C4 + XX * XX * XX * XX
    D0 = D0 + YY
    D1 = D1 + XX * YY
    D2 = D2 + XX * XX * YY
  Next I&
  C324 = C3 * C3 - C2 * C4: C213 = C2 * C2 - C1 * C3
  K0 = ((C1 * D1 - C2 * D0) * C324 - (C2 * D2 - C3 * D1) * C213) / ((C1 * C1 - C0 * C2) * C324 - C213 * C213)

  Return


End Sub

Sub HlfPwrWid(HPW, ByVal PL)
'  SHARED Lvl%(), MaxLvlAgl&, CT%, MaxAgl&, MaxLvl%, CenAglOf3dB&
  CT% = -1
  PL = PL * 100
  CrntAgl& = MaxLvlAgl&
  L& = 0
  For I& = 0 To MaxAgl&
    PreAgl& = CrntAgl&
    Do
      CrntAgl& = IncAgl&(CrntAgl&)
      L& = L& + 1
      If L& > MaxAgl& Then GoTo OveErr
    Loop Until Lvl%(CrntAgl&) <> NoLvl
    If Abs(MaxLvl% - Lvl%(CrntAgl&)) > PL Then Exit For
  Next I&
  AglDiff& = CrntAgl& - PreAgl&
  If AglDiff& < 0 Then
   AglDiff& = AglDiff& + MaxAgl&
  End If
    RgtAgl = PreAgl& - MaxLvlAgl&
    If RgtAgl < 0 Then
      RgtAgl = RgtAgl + MaxAgl&
    End If
    On Local Error GoTo HlfErr
    RgtAgl = RgtAgl + ((Lvl%(PreAgl&) - (MaxLvl% - PL)) / (Lvl%(PreAgl&) - Lvl%(CrntAgl&))) * AglDiff&
    On Error GoTo 0
    CrntAgl& = MaxLvlAgl&
    L& = 0
  For I& = 0 To MaxAgl&
    PreAgl& = CrntAgl&
    Do
      CrntAgl& = DecAgl&(CrntAgl&)
      L& = L& + 1
      If L& > MaxAgl& Then GoTo OveErr
    Loop Until Lvl%(CrntAgl&) <> NoLvl
    If Abs(MaxLvl% - Lvl%(CrntAgl&)) > PL Then Exit For
  Next I&
  AglDiff& = PreAgl& - CrntAgl&
  If AglDiff& < 0 Then AglDiff& = AglDiff& + MaxAgl&
  LftAgl = MaxLvlAgl& - PreAgl&
  If LftAgl < 0 Then LftAgl = LftAgl + MaxAgl&
  On Local Error GoTo HlfErr
  LftAgl = LftAgl + ((Lvl%(PreAgl&) - (MaxLvl% - PL)) / (Lvl%(PreAgl&) - Lvl%(CrntAgl&))) * AglDiff&
  On Error GoTo 0
  HPW = RgtAgl + LftAgl
  DCenAgl# = MaxLvlAgl& - LftAgl
  If DCenAgl# < 0 Then DCenAgl# = DCenAgl# + MaxAgl&
  DCenAgl# = DCenAgl# + HPW / 2
  If DCenAgl# > MaxAgl& Then DCenAgl# = DCenAgl# - MaxAgl&
  CenAglOf3dB& = DCenAgl#
es:
  Exit Sub
HlfErr:
   CT% = 0
'   BEEP
   Resume es
OveErr:
   CT% = 0

End Sub
Function LkfForMaxLvl%(FstAgl&, SndAgl&)
 ' SHARED Lvl%()
    LkfAgl& = DecAgl&(FstAgl&)
    CrntMaxLvl% = -NoLvl

   Do
    LkfAgl& = IncAgl&(LkfAgl&)
    While Lvl%(LkfAgl&) = NoLvl And LkfAgl& <> SndAgl&
      LkfAgl& = IncAgl&(LkfAgl&)
    Wend
    If Lvl%(LkfAgl&) <> NoLvl And Lvl%(LkfAgl&) > CrntMaxLvl% Then
      CrntMaxLvl% = Lvl%(LkfAgl&)
      CrntMaxLvlAgl& = LkfAgl&
    End If
  Loop Until LkfAgl& = SndAgl&
  FstAgl& = CrntMaxLvlAgl&
  LkfForMaxLvl% = CrntMaxLvl%
End Function

Function LOG10(ByVal Var)
  LOG10 = 0.4343944819 * Log(Var)
End Function

Sub LokForSL(Agl&, LLLA&, LL, RLLA&, RL)
' SHARED CT%, Lvl%(), MaxLvl%, MaxAgl&

  'Right Side Lob Level
  NextAgl& = Agl&
  CrntAgl& = Agl&
  Do
    L = XIELU(CrntAgl&, NextAgl&, 1)
    MapAgl& = CrntAgl&
    CrntAgl& = NextAgl&
    If Not (CT%) Then Exit Sub
  Loop Until L > 0
  Do
    L = XIELU(CrntAgl&, NextAgl&, 1)
    MapAgl2& = CrntAgl&
    CrntAgl& = NextAgl&
    If Not (CT%) Then Exit Sub
  Loop Until L < 0
  RL = (MaxLvl% - LkfForMaxLvl%(MapAgl&, MapAgl2&)) / 100
  RLLA& = MapAgl&
 'Left Side Lob Level
  CrntAgl& = Agl&
  Do
    L = XIELU(CrntAgl&, NextAgl&, -1)
    MapAgl& = CrntAgl&
    CrntAgl& = NextAgl&
    If Not (CT%) Then Exit Sub
  Loop Until L > 0
  Do
    L = XIELU(CrntAgl&, NextAgl&, -1)
    MapAgl2& = CrntAgl&
    CrntAgl& = NextAgl&
    If Not (CT%) Then Exit Sub
  Loop Until L < 0
  LL = (MaxLvl% - LkfForMaxLvl%(MapAgl2&, MapAgl&)) / 100
  LLLA& = MapAgl2&
End Sub

Function XIELU(PassAgl&, NextAgl&, LD%)
'  SHARED Lvl%(), CT%, MaxAgl&
  InPassAgl& = PassAgl&
  C1 = 5: HC1 = 3
  Dis = 0: C2 = 0: C3 = 0: C5 = 0: C6 = 0
  CT% = -1
  For I% = 1 To C1
    While Lvl%(InPassAgl&) = NoLvl
      If LD% > 0 Then
    InPassAgl& = IncAgl&(InPassAgl&)
      Else
    InPassAgl& = DecAgl&(InPassAgl&)
      End If
      Dis = Dis + 1
      If Dis > MaxAgl& Then GoTo Xlerr
    Wend
    If I% = 2 Then
       NextAgl& = InPassAgl&
    End If
    If I% = HC1 Then
      PassAgl& = InPassAgl&
    End If
    C2 = C2 + Dis
    C3 = C3 + Lvl%(InPassAgl&)
    C5 = C5 + Dis * Dis
    C6 = C6 + Dis * Lvl%(InPassAgl&)
    If LD% > 0 Then
      InPassAgl& = IncAgl&(InPassAgl&)
    Else
      InPassAgl& = DecAgl&(InPassAgl&)
    End If
    Dis = Dis + 1
    If Dis > MaxAgl& Then GoTo Xlerr
  Next I%
'  PassAgl& = InPassAgl&
  On Local Error GoTo Xl
  XIELU = (C6 - C2 * C3 / C1) / (C5 - C2 * C2 / C1)
  k = (C6 - C2 * C3 / C1) / (C5 - C2 * C2 / C1)
  On Error GoTo 0
  Exit Function

Xlerr:
  Beep
  CT% = 0
  XIELU = NoLvl
  Exit Function
Xl:
  Resume Xlerr

End Function

Sub GetFBR(CenAgl&, FBRAglAre%, FBR)
'  SHARED Lvl%(), CT%, MaxAgl&, MaxLvl%, FBRAgl&


  AglPont& = (FBRAglAre% / 360) * MaxAgl&
  CrntAgl& = CenAgl& + (MaxAgl& - AglPont&) / 2
  PreLvl% = -32767
  For I& = 0 To AglPont&
    CrntAgl& = IncAgl&(CrntAgl&)
    If Lvl%(CrntAgl&) <> NoLvl Then
      If Lvl%(CrntAgl&) > PreLvl% Then
     PreLvl% = Lvl%(CrntAgl&)
     FBRAgl& = CrntAgl&
      End If
    End If
  Next I&
  If PreLvl% = -32767 Then
     CT% = 0
  Else
     FBR = (MaxLvl% - PreLvl%) / 100
     CT% = -1
  End If

End Sub

Function EXP10(ByVal Var)
  EXP10 = Exp(2.302585093 * Var)
End Function