非球面レンズのVBAのプログラムリスト２章：非球面レンズの光線追跡計算式をVBAで書くと以下のようになります。
'グローバル変数の定義
Dim N(60) As Double, Rr(60) As Double, D(60) As Double, X(60) As Double
Dim U(60) As Double, Z(60) As Double, Ox(60) As Double
Dim Ki(60) As Double, A4i(60) As Double, A6i(60) As Double, A8i(60) As Double, A10i(60) As Double
Dim NUMB As Integer
Dim Fb(60) As Double, F(60) As Double, OL(60) As Double
'メインルーチン Sub 非球面レンズ計算実行()
ASN = ActiveSheet.Name
Sheets(ASN).Select
Dia = Sheets(ASN).Cells(7, 3).Value
Tc = Sheets(ASN).Cells(8, 3).Value
N0 = Sheets(ASN).Cells(9, 3).Value
N1 = Sheets(ASN).Cells(10, 3).Value
Tg = Sheets(ASN).Cells(11, 3).Value
Dg = Sheets(ASN).Cells(12, 3).Value
NJ = Sheets(ASN).Cells(13, 3).Value
WL = Sheets(ASN).Cells(14, 3).Value
R_1 = Sheets(ASN).Cells(17, 3).Value
K_1 = Sheets(ASN).Cells(18, 3).Value
A4_1 = Sheets(ASN).Cells(19, 3).Value
A6_1 = Sheets(ASN).Cells(20, 3).Value
A8_1 = Sheets(ASN).Cells(21, 3).Value
A10_1 = Sheets(ASN).Cells(22, 3).Value
R_2 = Sheets(ASN).Cells(17, 4).Value
K_2 = Sheets(ASN).Cells(18, 4).Value
A4_2 = Sheets(ASN).Cells(19, 4).Value
A6_2 = Sheets(ASN).Cells(20, 4).Value
A8_2 = Sheets(ASN).Cells(21, 4).Value
A10_2 = Sheets(ASN).Cells(22, 4).Value
'正方向入射特性評価
NUMB = 5
N(0) = 1
D(0) = 0
Ox(0) = 0
Rr(0) = 0
Ki(0) = 0
A4i(0) = 0
A6i(0) = 0
A8i(0) = 0
A10i(0) = 0
N(1) = N0
D(1) = D(0) + Tc
Ox(1) = 0
Rr(1) = 1 / R_1
Ki(1) = K_1
A4i(1) = A4_1
A6i(1) = A6_1
A8i(1) = A8_1
A10i(1) = A10_1
N(2) = 1
D(2) = D(1) + Dg
Ox(2) = 0
Rr(2) = 1 / R_2
Ki(2) = K_2
A4i(2) = A4_2
A6i(2) = A6_2
A8i(2) = A8_2
A10i(2) = A10_2
N(3) = N1
D(3) = D(2) + Tg
Ox(3) = 0
Rr(3) = 0
Ki(3) = 0
A4i(3) = 0
A6i(3) = 0
A8i(3) = 0
A10i(3) = 0
N(4) = 1
D(4) = D(3) + 0
Ox(4) = 0
Rr(4) = 0
Ki(4) = 0
A4i(4) = 0
A6i(4) = 0
A8i(4) = 0
A10i(4) = 0
For i = 1 To 10
For j = 0 To 50
Sheets(ASN).Cells(27 + j, i).Formula = ""
Next j
Next i
U(0) = 0
For i = 0 To NJ
If i = 0 Then
X(0) = 0.001
Else
X(0) = i * Dia / (2 * NJ)
End If
CAL '光線追跡実行
Fb(i) = -D(NUMB - 1) + Z(NUMB - 1) + X(NUMB - 1) / Tan(U(NUMB - 1)) 'バックフォーカス
F(i) = X(0) / Sin(U(NUMB - 1)) '焦点距離
OLi = 0
For k = 0 To NUMB - 2 '光路長の集計
OLi = OLi + (Z(k + 1) - Z(k)) * N(k) / Cos(U(k))
Next k
OLi = OLi + (D(NUMB - 1) - Z(NUMB - 1) + Fb(0)) * N(NUMB - 1) / Cos(U(NUMB - 1))
If i = 0 Then
OL0 = OLi
End If
X(NUMB) = X(NUMB - 1) - Tan(U(NUMB - 1)) * (D(NUMB - 1) - Z(NUMB - 1) + Fb(0))
OL(i) = (OLi - OL0 + Sin(U(NUMB - 1)) * X(NUMB)) * 1000000 / WL '波面収差計算
Sheets(ASN).Cells(27 + i, 1).Value = i / NJ
Sheets(ASN).Cells(27 + i, 2).Value = X(0)
Sheets(ASN).Cells(27 + i, 3).Value = F(i)
Sheets(ASN).Cells(27 + i, 4).Value = Fb(i) + Tg + Dg
Sheets(ASN).Cells(27 + i, 5).Value = OL(i)
Sheets(ASN).Cells(27 + i, 6).Value = U(NUMB - 1)
Next i
'逆方向入射特性評価
NUMB = 5 N(0) = 1
D(0) = 0
Ox(0) = 0
Rr(0) = 0
Ki(0) = 0
A4i(0) = 0
A6i(0) = 0
A8i(0) = 0
A10i(0) = 0
N(1) = N1
D(1) = D(0) + Tg
Ox(1) = 0
Rr(1) = 0
Ki(1) = 0
A4i(1) = 0
A6i(1) = 0
A8i(1) = 0
A10i(1) = 0
N(2) = 1
D(2) = D(1) + Dg
Ox(2) = 0
Rr(2) = 0
Ki(2) = 0
A4i(2) = 0
A6i(2) = 0
A8i(2) = 0
A10i(2) = 0
N(3) = N0
D(3) = D(2) + Tc
Ox(3) = 0
Rr(3) = -1 / R_2
Ki(3) = K_2
A4i(3) = -A4_2
A6i(3) = -A6_2
A8i(3) = -A8_2
A10i(3) = -A10_2
N(4) = 1
D(4) = D(3) + 0
Ox(4) = 0
Rr(4) = -1 / R_1
Ki(4) = K_1
A4i(4) = -A4_1
A6i(4) = -A6_1
A8i(4) = -A8_1
A10i(4) = -A10_1
U(0) = 0
For i = 0 To NJ
If i = 0 Then
X(0) = 0.001
Else
X(0) = i * Dia / (2 * NJ)
End If
CAL '光線追跡実行
Fb(i) = -D(NUMB - 1) + Z(NUMB - 1) + X(NUMB - 1) / Tan(U(NUMB - 1))
F(i) = X(0) / Sin(U(NUMB - 1))
OLi = 0
For k = 0 To NUMB - 2
OLi = OLi + (Z(k + 1) - Z(k)) * N(k) / Cos(U(k))
Next k
OLi = OLi + (D(NUMB - 1) - Z(NUMB - 1) + Fb(0)) * N(NUMB - 1) / Cos(U(NUMB - 1))
If i = 0 Then
OL0 = OLi
End If
X(NUMB) = X(NUMB - 1) - Tan(U(NUMB - 1)) * (D(NUMB - 1) - Z(NUMB - 1) + Fb(0))
OL(i) = (OLi - OL0 + Sin(U(NUMB - 1)) * X(NUMB)) * 1000000 / WL
Sheets(ASN).Cells(27 + i, 7).Value = F(i)
Sheets(ASN).Cells(27 + i, 8).Value = Fb(i)
Sheets(ASN).Cells(27 + i, 9).Value = OL(i)
Sheets(ASN).Cells(27 + i, 10).Value = U(NUMB - 1)
Next i
End Sub
'ユーザ定義関数 非球面レンズ面の関数
Function Fz(y, R1, k, A4, A6, A8, A10)
Fx1 = y ^ 2 / (R1 * (1 + Sqr(1 - (1 + k) * y ^ 2 / R1 ^ 2)))
Fx2 = A4 * y ^ 4 + A6 * y ^ 6 + A8 * y ^ 8 + A10 * y ^ 10
Fz = Fx1 + Fx2
End Function
'ユーザ定義関数 ニュートン法のための中間関数
Function Gx(X1, X0, U0, Ox1, D0, Z0, R1, k, A4, A6, A8, A10)
Gx = X1 - X0 + Tan(U0) * (Fz(X1 - Ox1, R1, k, A4, A6, A8, A10) + D0 - Z0)
End Function
'ユーザ定義関数 Ziを求める
Function Zi(X0, U0, Ox1, D0, Z0, Rr1, k, A4, A6, A8, A10)
If Rr1 = 0 Then
'Rr1 = 0(Rk=∞)の場合の処理
Zi = D0
Else
'Rr1 = 0(Rk=∞)以外の場合の処理
R1 = 1 / Rr1
dx = 0.001
X1 = X0
'ニュートン法でX1を求める
For i = 1 To 10
Gx0 = Gx(X1, X0, U0, Ox1, D0, Z0, R1, k, A4, A6, A8, A10)
Gxm = Gx(X1 - dx, X0, U0, Ox1, D0, Z0, R1, k, A4, A6, A8, A10)
Gxp = Gx(X1 + dx, X0, U0, Ox1, D0, Z0, R1, k, A4, A6, A8, A10)
X1 = X1 - Gx0 * 2 * dx / (Gxp - Gxm)
Next i
'Z1を求める
Zi = Fz(X1 - Ox1, R1, k, A4, A6, A8, A10) + D0
End If
End Function
'ユーザ定義関数 面の傾斜を求める
Function TSx(X1, R1, k, A4, A6, A8, A10)
dx = 0.001
Xp = X1 + dx
Fxp = Fz(Xp, R1, k, A4, A6, A8, A10)
Xm = X1 - dx
Fxm = Fz(Xm, R1, k, A4, A6, A8, A10)
TSx = (Fxp - Fxm) / (2 * dx)
End Function
'ユーザ定義関数 Uiを求める
Function Ui(X1, Rr1, k, A4, A6, A8, A10, N0, N1, U0)
If Rr1 = 0 Then
Sx = 0
Else
R1 = 1 / Rr1
Pix = Application.WorksheetFunction.Pi()
AL = TSx(X1, R1, k, A4, A6, A8, A10)
Sx = Atn(TSx(X1, R1, k, A4, A6, A8, A10))
End If
Sn01 = (N0 / N1) * Sin(Sx - U0)
If Abs(Sn01) < 1 Then
Ui = Sx - Application.WorksheetFunction.Asin(Sn01)
Else
Ui = 0.0000000001
End If
End Function
'光線追跡サブルーチン Z(i + 1)、X(i + 1)、U(i + 1)を求める
Sub CAL()
For i = 0 To NUMB - 2
If (Rr(i + 1) = 0) Then
Z(i + 1) = D(i)
X(i + 1) = X(i) - Tan(U(i)) * (Z(i + 1) - Z(i))
Sx = 0
U(i + 1) = Sx - Application.WorksheetFunction.Asin(N(i) * Sin(Sx - U(i)) / N(i + 1))
Else
Z(i + 1) = Zi(X(i), U(i), Ox(i + 1), D(i), Z(i), Rr(i + 1), Ki(i + 1), A4i(i + 1), A6i(i + 1), A8i(i + 1), A10i(i + 1))
X(i + 1) = X(i) - Tan(U(i)) * (Z(i + 1) - Z(i))
U(i + 1) = Ui(X(i + 1), Rr(i + 1), Ki(i + 1), A4i(i + 1), A6i(i + 1), A8i(i + 1), A10i(i + 1), N(i), N(i + 1), U(i))
End If
Next i
End Sub
解説- グローバル変数の定義
グローバル変数を定義しています。
- メインルーチン
「計算実行ボタン」を押すと実行されます。
グローバル変数に入力パラメータを設定します。
光線追跡を実行します。
光路長と波面収差、焦点距離、バックフォーカスを計算します。
計算結果を表示します。
- ユーザ定義関数 非球面レンズ面の関数
非球面レンズ面の関数を定義しています。
- ユーザ定義関数 ニュートン法のための中間関数
ニュートン法のための中間関数を定義しています。
- ユーザ定義関数 Ziを求める
ニュートン法によりZiを求めます。
- ユーザ定義関数 Uiを求める
Uiを求めます。
- 光線追跡サブルーチン Z(i + 1)、X(i + 1)、U(i + 1)を求める
光線追跡を実行します。
４章：非球面レンズの光線追跡フリーソフトに行く。