probks.txt

《Delphi常用数值算法集》的配书源码

Function PROBKS(ALAM:real):real;
label 99;
const
    EPS1 = 0.001;    EPS2 = 0.00000001;
var 
    A2,FAC,TERMBF,TERM,AAA,PRO:real;  J:integer;
begin
    A2:=-2 * Sqr(ALAM);
    FAC:=2; 
    PRO:=0; 
    TERMBF:=0; 
    For J:=1 To 100 do
    begin
        TERM:=FAC * Exp(A2 * J*J);
        PRO:=PRO + TERM;
        AAA:=Abs(TERM);
        If (AAA < EPS1 * TERMBF) Or (AAA < EPS2 * PRO) Then
            goto 99;
        FAC:=-FAC;
        TERMBF:=Abs(TERM);
    end;
    PRO:=1;
99: PROBKS:=PRO;
end;