unit1.pas

用于开发税务票据管理的软件

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  matrx2=array of array of real;
procedure USRFUN(X:array of real;var ALPHA:matrx2;var BETA:array of real);
var
  Form1: TForm1;

implementation
//PROGRAM D8R13
//Driver for routine MNEWT
uses
  unit2;
  {$R *.DFM}
procedure USRFUN(X:array of real;var ALPHA:matrx2;var BETA:array of real);
const
    NP = 15;
begin
    ALPHA[1, 1]:=-2 * X[1];  ALPHA[1, 2]:=-2 * X[2];
    ALPHA[1, 3]:=-2 * X[3];  ALPHA[1, 4]:=1;
    ALPHA[2, 1]:=2 * X[1];   ALPHA[2, 2]:=2 * X[2];
    ALPHA[2, 3]:=2 * X[3];   ALPHA[2, 4]:=2 * X[4];
    ALPHA[3, 1]:=1;          ALPHA[3, 2]:=-1;
    ALPHA[3, 3]:=0;          ALPHA[3, 4]:=0;
    ALPHA[4, 1]:=0;          ALPHA[4, 2]:=1;
    ALPHA[4, 3]:=-1;         ALPHA[4, 4]:=0;
    BETA[1]:=Sqr(X[1]) + Sqr(X[2]) + Sqr(X[3]) - X[4];
    BETA[2]:=-Sqr(X[1]) - Sqr(X[2]) - Sqr(X[3]) - Sqr(X[4]) + 1;
    BETA[3]:=-X[1] + X[2];
    BETA[4]:=-X[2] + X[3];
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  s1='.#####0E+00';  s2='0';  S3='%4.2f';
  N = 4; NTRIAL = 5; TOLF = 0.00001; TOLX = 0.00001; NP = 15;
var
  F:TextFile;
  X,BETA:array[0..15] of real;  ALPHA:matrx2;
  I,J,IFLAG,NROOT,NFLAG,K,KK:integer;   XX,AAA,BBB:real;
begin
  SetLength(ALPHA,16,16);
  //输出计算结果到文件
  AssignFile(F, 'd:\delphi_shu\p8\d8r13.dat');
  Rewrite(F);
  repeat
    KK:=-1;
    For K:=1 To 3 do
    begin
      XX:=0.2 * K * KK;
      Writeln(F, 'Starting vector number', FormatFloat(s2,K));
      For I:=1 To 4 do
      begin
        X[I]:=XX + 0.2 * I;
        Writeln(F, '   X(', FormatFloat(s2,I), ')= ',Format(s3,[X[I]]));
      end;
      For J:=1 To NTRIAL  do
      begin
        MNEWT(1, X, N, TOLX, TOLF);
        USRFUN(X, ALPHA, BETA);
        Writeln(F, '   I         X(I)           F');
        For I:=1 To N do
          Writeln(F,'   ',FormatFloat(s2,I),'    ',FormatFloat(s1,X[I]),
                    '    ',FormatFloat(s1,-BETA[I]));
      end;
    end;
    KK:=KK + 2;
  until KK < 2;
  CloseFile(F);
  //屏幕显示计算结果
  memo1.Lines.LoadFromFile('d:\delphi_shu\p8\d8r13.dat');
end;

end.