投稿者 ひでと  (社会人) 投稿日時 2011/12/20 12:38:28
ぐっさん 様、ありがとうございました。お礼がおそくなりまして、申し訳ありません。

いただいたアドバイスで以下のようにしてみました。変数は省略しています

解を求めたい関数
    Private Function pf(ByVal x As Double) As Double
        Return x ^ 3 + 3 * (pe() - D / 2) * x ^ 2 - 6 * sn * at / b * (pe() + D / 2 - dt) * (D - dt - sn)
    End Function
微分した関数
    Private Function fd(ByVal x As Single) As Double
        Return 3 * x ^ 2 + 6 * (pe() - D / 2) * x
    End Function

解をxnとして
   Private Function xn() As Double
        Dim 初期値 As Double = sd
        Dim dum As Double = newton(10)
        If Math.Abs(pf(dum)) < 0.00001 Then Return dum
        'y=fd*xn+c
        Dim y As Double = pf(dum)
        Dim c As Double = y - fd(dum) * dum
        Dim 初期値1 As Double = (-y - c) / fd(dum)
        Dim 初期値2 As Double = dum
        dum = Bisection(初期値1, 初期値2)
        Return dum
    End Function

まずはニュートン法で
   Private Function newton(ByVal 初期値 As Double) As Double
        'y=fd*xn+c
        Dim xn As Double = 初期値
        Dim i As Integer
        Dim old As Double
        For i = 0 To 100
            Dim y As Double = pf(xn)
            If old = y Then
                Return xn
            End If
            old = y
            If Math.Abs(y) < 0.00001 Then
                Exit For
            End If
            Dim c As Double = y - fd(xn) * xn
            xn = -c / fd(xn)
        Next
        Return xn
    End Function

ニ分法も使ってみて
    Private Function Bisection(ByVal 初期値1 As Double, ByVal 初期値2 As Double) As Double
        If pf(初期値1) * pf(初期値2) > 0 Then
            MsgBox("解を求めることができませんでした")
            Return 初期値2
        End If
        Dim a, b, m As Double
        a = 初期値1 : b = 初期値2
        Dim i As Integer
        For i = 0 To 100
            m = (a + b) / 2
            If Math.Abs(pf(m)) < 0.00001 Then Exit For
            If pf(m) * pf(b) < 0 Then
                a = m
            Else
                b = m
            End If
        Next
        Return m
    End Function

このようにしてみました。
はじめSingleで定義していたとき、ニュートン法だと傾きの精度が足りず、解を求められなかったので、
その近似値?を二分法に使用してみようと考えました。
結局二分法でも精度が足りず、doubleで定義しなおしましたが・・・・・。
試行錯誤、面白かったです。ありがとうございました。