simp2.txt

最近开发的,比较使用,曲线拟合,谢谢下载 ,没问题

Procedure SIMP2(var A:matrx2; M, N, MP, NP:integer; L2:array of integer;
                                 NL2:integer;var IP, KP:integer; Q1:real);
label 1,2;
const
    EPS = 0.000001;
var
    I,J,II,K:integer;  FLAG,Q,QP,Q0:real;
begin
    IP:=0;
    FLAG:=0;
    For I:=1 To NL2 do
    begin
        If A[L2[I] + 1, KP + 1] < -EPS Then FLAG:=1;
        If FLAG = 1 Then goto 1;
    end;
1:  If FLAG = 0 Then Exit;
    Q1:=-A[L2[I] + 1, 1] / A[L2[I] + 1, KP + 1];
    IP:=L2[I];
    For I:=I + 1 To NL2 do
    begin
        II:=L2[I];
        If A[II + 1, KP + 1] < -EPS Then
        begin
            Q:=-A[II + 1, 1] / A[II + 1, KP + 1];
            If Q < Q1 Then
            begin
                IP:=II;
                Q1:=Q;
            end
            Else If Q = Q1 Then
            begin
                For K:=1 To N do
                begin
                    QP:=-A[IP + 1, K + 1] / A[IP + 1, KP + 1];
                    Q0:=-A[II + 1, K + 1] / A[II + 1, KP + 1];
                    If Q0 <> QP Then goto 2;
                end;
2:              If Q0 < QP Then IP:=II;
            end;
        end;
    end;
end;