Проектирование и расчет нерекурсивного фильтра, страница 6

' введем параметры моделирования, константы и переменные

'исходные данные:

Const Q_f = 9#                                      ' верхняя граничная частота полосы пропускания

Const delta_w_n = 1.5                          ' ширина переходной полосы

Const L = 100                                       ' количество членов ряда Фурье

Const K_f = 1.5                                    ' коэффициент усиления фильтра в полосе пропускания

Const delta_t = 0.1                               ' шаг дискретизации по времени

Const Pi = 3.14

'переменные:

Dim Q_r As Double                             'верхняя граничная частота полосы пропускания расчетной АЧХ

Dim sigma() As Double                       'множители Ланцоша

Dim A() As Double                             'коэффициенты ак

Dim w() As Double                             'отсчеты импульсной характеристики

Dim v As Double                                'частота w

Dim delta_v As Double                       'шаг дискретизации по частоте w

Dim A1() As Variable                         'значения АЧХ

Dim fi() As Double                             'значения ФЧХ

Dim k As Integer

Private Sub filtr_Click()

'  удаляем содержимое всех ячеек перед началом моделирования

Worksheets(1).Cells.Clear

' рассчитываем верхнюю граничную частоту полосы пропускания расчетной АЧХ

Q_r = Q_f + delta_w_n / 2

'рассчитываем совокупность (L+1) сглаживающих множителей Ланцоша

'определяем первый множитель Ланцоша

ReDim Preserve sigma(0)

sigma(0) = 1

Worksheets(1).Cells(14, 1) = 0        'помещаем номер множителя и его значение в ячейки

Worksheets(1).Cells(14, 2) = 1

'вычисляем остальные L множителей Ланцоша

For k = 1 To L

ReDim Preserve sigma(k)

sigma(k) = (Sin(k * Pi / L)) / (k * Pi / L)

'помещаем номера множителей и их значения в ячейки   

Worksheets(1).Cells(14 + k, 1) = k

Worksheets(1).Cells(14 + k, 2) = Round(sigma(k), 6)

Next

 'вычисляем совокупность (L+1) коэффициентов ak

` вычисляем коэффициент а0

ReDim Preserve A(0)

A(0) = (2 * K_f * Q_r) / (Pi * delta_t)

Worksheets(1).Cells(16, 1) = 0   'помещаем номер коэффициента а0 и его значение в ячейки

Worksheets(1).Cells(16, 2) = A(0)

'вычисляем оставшиеся  L коэффициентов ак

For k = 1 To L

ReDim Preserve A(k)

A(k) = 2 * K_f * Sin(k * delta_t * Q_r) / (k * Pi)

'помещаем номера коэффициентов ак и их значения в ячейки

Worksheets(1).Cells(16 + k, 1) = k

Worksheets(1).Cells(16 + k, 2) = Round(A(k), 4)

Next

 'вычисляем набор отсчетов импульсной характеристики:

Worksheets(1).Cells(1, 3) = "k"

Worksheets(1).Cells(1, 4) = "W(k)"

For k = 0 To 2 * L

ReDim Preserve w(k)

If k < L + 1 Then

w(k) = 0.5 * sigma(L - k) * A(L - k)

Else

w(k) = 0.5 * sigma(k - L) * A(k - L)

End If

Worksheets(1).Cells(k + 2, 3) = k                        'помещаем номера отсчетов имп.характеристики

Worksheets(1).Cells(k + 2, 4) = Round(w(k), 4)  'и их значения в ячейки                

Next

' вычисляем значения АЧХ и ФЧХ спроектированного фильтра

Worksheets(1).Cells(1, 5) = "k"

Worksheets(1).Cells(1, 6) = "АЧХ"

Worksheets(1).Cells(1, 7) = "ФЧХ"

' находим шаг дискретизации по частоте

delta_v = (2 * Pi) / (2 * L * delta_t)

For v = 0 To (15) Step delta_v

' вычисляем значения АЧХ

A0 =W(L)

Sum = 0

For k = 1 To L

Sum = Sum + 2 * W(L - k) * Cos(k * d_t * v)

Next

A1 = Abs(A0 + Sum)

Next

'выводим значения частоты w и найденные значения АЧХ в ячейки

Worksheets(1).Cells(v + 2, 5) = Round(v, 3)

Worksheets(1).Cells(v + 2, 6) = Round(A1, 6)

' вычисляем значения ФЧХ

For v = 0 To (15) Step delta_v

fi = -(L * delta_t * v)

'выводим найденные значения ФЧХ в ячейки

Worksheets(1).Cells(v + 2, 7) = Round(fi, 4)

Next

'строим идеальную АЧХ заданного фильтра

Const delta_a = 1

Worksheets(1).Cells(6, 1) = "w"

Worksheets(1).Cells(6, 2) = "Ai(w)"

Worksheets(1).Cells(7, 1) = 0

Worksheets(1).Cells(7, 2) = K_f

Worksheets(1).Cells(8, 1) = Q_f

Worksheets(1).Cells(8, 2) = K_f

Worksheets(1).Cells(9, 1) = Q_f + delta_w_n

Worksheets(1).Cells(9, 2) = 0

Worksheets(1).Cells(10, 1) = Q_f + delta_w_n + delta_a

Worksheets(1).Cells(10, 2) = 0

Worksheets(1).Cells(11, 1) = Q_f + delta_w_n  + 2 * delta_a

Worksheets(1).Cells(11, 2) = 0

Worksheets(1).Cells(12, 1) = Q_f + delta_w_n  + 3 * delta_a

Worksheets(1).Cells(12, 2) = 0

Worksheets(1).Cells(13, 1) = Q_f + delta_w_n  + 4 * delta_a

Worksheets(1).Cells(13, 2) = 0

Worksheets(1).Cells(14, 1) = Q_f + delta_w_n  + 5 * delta_a

Worksheets(1).Cells(14, 2) = 0

End Sub