数学算法

源代码在线查看: zbrent.txt

软件大小: 1410 K
上传用户: xhaibo
关键词: 算法
下载地址: 免注册下载 普通下载 VIP

相关代码

				Function ZBRENT(X1, X2, TOL:real):real;
				var
				    ITMAX,ITER:integer;  ZZ,S,AAA,EPS,FA,FB,FC,C,TOL1,XM,P,Q,R,D,E,A,B:real;
				begin
				    ITMAX:=100;
				    EPS:=0.00000003;
				    A:=X1;
				    B:=X2;
				    FA:=FUN(A);
				    FB:=FUN(B);
				    If FB * FA > 0  Then
				        ShowMessage('Root must be bracketed for ZBRENT');
				    FC:=FB;
				    For ITER:=1 To ITMAX do
				    begin
				        If FB * FC > 0 Then
				        begin
				            C:=A;
				            FC:=FA;
				            D:=B - A;
				            E:=D;
				        end;
				        If Abs(FC) < Abs(FB) Then
				        begin
				            A:=B;
				            B:=C;
				            C:=A;
				            FA:=FB;
				            FB:=FC;
				            FC:=FA;
				        end;
				        TOL1:=2 * EPS * Abs(B) + 0.5 * TOL;
				        XM:=0.5 * (C - B);
				        If (Abs(XM) 				        begin
				            ZBRENT:=B;
				            Exit;
				        end;
				        If (Abs(E) >= TOL1) And (Abs(FA) > Abs(FB)) Then
				        begin
				            S:=FB / FA;
				            If A = C Then
				            begin
				                P:=2 * XM * S;
				                Q:=1 - S;
				            end
				            Else
				            begin
				                Q:=FA / FC;
				                R:=FB / FC;
				                P:=S * (2 * XM * Q * (Q - R) - (B - A) * (R - 1 ));
				                Q:=(Q - 1 ) * (R - 1 ) * (S - 1 );
				            end;
				            If P > 0  Then Q:=-Q;
				            P:=Abs(P);
				            If 3 * XM * Q - Abs(TOL1*Q) < Abs(E*Q) Then
				                AAA:=3  * XM * Q - Abs(TOL1 * Q)
				            Else
				                AAA:=Abs(E * Q);
				            If 2 * P < AAA Then
				            begin
				                E:=D;
				                D:=P / Q;
				            end
				            Else
				            begin
				                D:=XM;
				                E:=D;
				            end;
				        end
				        Else
				        begin
				            D:=XM;
				            E:=D;
				        end;
				        A:=B;
				        FA:=FB;
				        If Abs(D) > TOL1 Then
				            B:=B + D
				        Else
				        Begin
				            If XM>=0 then
				                ZZ:=1
				            Else
				                ZZ:=-1;
				            B:=B + Abs(TOL1) * ZZ;
				        end;
				        FB:=FUN(B);
				    end; 
				    ShowMessage('ZBRENT exceeding maximum iterations.');
				    ZBRENT:=B;
				end;			

相关资源