unit arraysc;
{$MODE DELPHI}{$H+}

interface

uses
  Classes, SysUtils,
  base, base2, mathc, arrays, textfile;

type
    TComplexArray=array [0..1023] of Complex;
    PComplexArray=^TComplexArray;
type
   TArray2C=class;

      TArray1C=Class(TArray1)
         elements:PComplexArray;
         procedure subst(a:TArray1C);overload;
         procedure subst(a:TArray2C);overload;
         procedure trn(a:TArray2C);overload;
         procedure add(a,b:TArray1C);
         procedure sub(a,b:TArray1C);
         procedure prod(a:TArray1C; b:TArray2C); overload;
         procedure prod(a:TArray2C; b:TArray1C); overload;
         procedure scalar(x:double; a:TArray1C); overload;
         procedure scalar(x:complex; a:TArray1C); overload;
         procedure con;overload;
         procedure con(x:double);overload;
         procedure con(x:complex);overload;
         procedure zer;overload;
         procedure zer(x:double);overload;
         procedure zer(x:complex);overload;
         procedure CROSS(a,b:TArray1C);
         procedure conj(a:TArray1C);
         procedure row(a:TArray2C; n:integer);overload;
         procedure column(a:TArray2C; n:integer);overload;
         procedure row(a:TArray2C; n:Complex); overload;
         procedure column(a:TArray2C; n:Complex); overload;
         destructor destroy;override;
         function InputDirective:string;
         function NewCopy:TArray1C;
         procedure MatPrint(ch:tTextDevice; direction:integer);override;
         procedure MatWrite(ch:tTextDevice);override;
         function kindlist:ansistring;
         procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
         procedure AssignVarilen(list:TstringList);override;
         procedure LetWithTrace(ch:tTextDevice; name: ansistring;
                                                index1:complex; value: complex);
         function Array1N:TArray1N;
         function Array2N:TArray2N;   //実部と虚部に分離
         procedure WriteTo(p:Pointer; size1:integer);
         procedure ReadFrom(p:Pointer; size1:integer);

        private
         procedure init(lb1,ub1:NativeInt);override;
         constructor createCopy(a:TArray1C);
         procedure CROSSsub(a,b:TArray1C);
       end;

      TArray2C=Class(TArray2)
         elements:PComplexArray;
         procedure subst(a:TArray2C);
         procedure add(a,b:TArray2C);
         procedure sub(a,b:TArray2C);
         procedure prod(a:TArray2C; b:TArray2C);
         procedure INV(a:TArray2C);
         procedure TRN(a:TArray1C); overload;
         procedure TRN(a:TArray2C); overload;
         procedure scalar(x:double; a:TArray2C); overload;
         procedure scalar(x:complex;a:TArray2C); overload;
         procedure power(a:Tarray2C; x:double); overload;
         procedure power(a:Tarray2C; x:complex); overload;
         procedure zer;overload;
         procedure zer(x:double);overload;
         procedure zer(x:complex);overload;
         procedure CON;overload;
         procedure CON(x:double);overload;
         procedure CON(x:complex);overload;
         procedure IDN;          overload;
         procedure IDN(x:double);overload;
         procedure IDN(x:complex);overload;
         procedure conj(a:TArray2C);
         procedure row(a:TArray2C;m,n:integer); overload;
         procedure column(a:TArray2C;m,n:integer); overload;
         procedure SubstRow1(n:integer; a:TArray1C);overload;
         procedure SubstRow2(m,n:integer; a:TArray2C);overload;
         procedure SubstColumn1(n:integer; a:TArray1C); overload;
         procedure SubstColumn2(m,n:integer; a:TArray2C);overload;
         procedure row(a:TArray2C;m,n:Complex); overload;
         procedure column(a:TArray2C;m,n:Complex); overload;
         procedure SubstRow1(n:Complex; a:TArray1C);overload;
         procedure SubstRow2(m,n:Complex; a:TArray2C);overload;
         procedure SubstColumn1(n:Complex; a:TArray1C); overload;
         procedure SubstColumn2(m,n:Complex; a:TArray2C);overload;
         destructor destroy;override;
         function InputDirective:string;
         function NewCopy:TArray2C;
         procedure MatPrint(ch:tTextDevice; direction:integer);override;
         procedure MatWrite(ch:tTextDevice);override;
         function kindlist:ansistring;
         procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
         procedure LetWithTrace(ch:tTextDevice; name: ansistring;
                                                index1,index2:complex; value: complex);

         function Array2N:TArray2N;
         procedure WriteTo(p:Pointer; size1:integer);
         procedure ReadFrom(p:Pointer; size1:integer);
        private
         procedure init(lb1,ub1,lb2,ub2:NativeInt);override;
         constructor createCopy(a:TArray2C);
         procedure prodsub(a:TArray2C; b:TArray2C);
         procedure TRNSub(a:TArray2C);
         procedure determinant(var n:complex);
         function inverse:TArray2C;
       end;

      TArray3C=Class(TArray3)
         elements:PComplexArray;
         procedure subst(a:TArray3C);
         procedure add(a,b:TArray3C);
         procedure sub(a,b:TArray3C);
         procedure scalar(x:double; a:TArray3C);overload;
         procedure scalar(x:complex;a:TArray3C);overload;
         procedure zer;overload;
         procedure zer(x:double);overload;
         procedure zer(x:complex);overload;
         procedure CON;overload;
         procedure CON(x:double);overload;
         procedure CON(x:complex);overload;
         procedure conj(a:TArray3C);
         destructor destroy;override;
         function InputDirective:string;
         function NewCopy:TArray3C;
         procedure MatPrint(ch:tTextDevice; direction:integer);override;
         procedure MatWrite(ch:tTextDevice);override;
         function kindlist:ansistring;
         procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
         procedure LetWithTrace(ch:tTextDevice; name: ansistring;
                                                index1,index2,index3:complex; value: complex);

         procedure WriteTo(p:Pointer; size1:integer);
         procedure ReadFrom(p:Pointer; size1:integer);
        private
         procedure init(lb1,ub1,lb2,ub2,lb3, ub3:NativeInt); override;
         constructor createCopy(a:TArray3C);

       end;

      TArray4C=Class(TArray4)
         elements:PComplexArray;
         procedure subst(a:TArray4C);
         procedure add(a,b:TArray4C);
         procedure sub(a,b:TArray4C);
         procedure scalar(x:double; a:TArray4C);overload;
         procedure scalar(x:complex;a:TArray4C);overload;
         procedure zer;overload;
         procedure zer(x:double);overload;
         procedure zer(x:complex);overload;
         procedure CON;overload;
         procedure CON(x:double);overload;
         procedure CON(x:complex);overload;
         procedure conj(a:TArray4C);
         destructor destroy;override;
         function InputDirective:string;
         function NewCopy:TArray4C;
         procedure MatPrint(ch:tTextDevice; direction:integer);override;
         procedure MatWrite(ch:tTextDevice);override;
         function kindlist:ansistring;
         procedure Read(list:TStringList;var p:integer);override; //listのpの位置から読む
         procedure LetWithTrace(ch:tTextDevice; name: ansistring;
                                      index1,index2,index3,index4:complex; value: complex);
         procedure WriteTo(p:Pointer; size1:integer);
         procedure ReadFrom(p:Pointer; size1:integer);
        private
         procedure init(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt); override;
         constructor createCopy(a:TArray4C);

       end;




   function dot(a,b:TArray1C):complex; overload;
   function DET(a:TArray2C):complex;   overload;

   {*****************}
   {Matrix operations}
   {*****************}

   function matrixIDN(a:TArray2C): TArray2C; overload;
   function matrixIDN(a:TArray2C; x:double): TArray2C; overload;
   function matrixTRN(a,b:TArray2C): TArray2C; overload;
   function matrixTRN(a:TArray2C; b:TArray1C): TArray2C; overload;
   function matrixINV(a,b:TArray2C):Tarray2C;overload;
   function matrixCNJ(a,b:TArray1C):Tarray1C;overload;
   function matrixCNJ(a,b:TArray2C):Tarray2C;overload;
   function matrixCNJ(a,b:TArray3C):Tarray3C;overload;
   function matrixCNJ(a,b:TArray4C):Tarray4C;overload;
   function matrixPOWER(a,b:TArray2C; x:double):TArray2C; overload;
   function matrixScalar(a:TArray1C; x:complex; b:TArray1C):TArray1C;overload;
   function matrixScalar(a:TArray2C; x:complex; b:TArray2C):TArray2C;overload;
   function matrixScalar(a:TArray3C; x:complex; b:TArray3C):TArray3C;overload;
   function matrixScalar(a:TArray4C; x:complex; b:TArray4C):TArray4C;overload;
   function matrixProd(a,b:TArray1C; c:TArray2C):TArray1C;overload;
   function matrixProd(a,b,c:TArray2C):TArray2C;overload;
   function matrixAdd(a,b,c:TArray1C):TArray1C;overload;
   function matrixSbt(a,b,c:TArray1C):TArray1C;overload;
   function matrixAdd(a,b,c:TArray2C):TArray2C;overload;
   function matrixSbt(a,b,c:TArray2C):TArray2C;overload;
   function matrixAdd(a,b,c:TArray3C):TArray3C;overload;
   function matrixSbt(a,b,c:TArray3C):TArray3C;overload;
   function matrixAdd(a,b,c:TArray4C):TArray4C;overload;
   function matrixSbt(a,b,c:TArray4C):TArray4C;overload;
   function matrixInit(a:TArray1C; args:array of const): TArray1C; overload;
   function matrixRow1(a:TArray1C;b:TArray2C; i:double):Tarray1C;
   function matrixColumn1(a:TArray1C;b:TArray2C; i:double):Tarray1C;
   function matrixRow2(a:TArray2C; b:TArray2C; i,j:double):Tarray2C;
   function matrixColumn2(a:TArray2C; b:TArray2C; i,j:double):Tarray2C;



implementation
uses baslibc;

procedure TArray1C.init(lb1,ub1:NativeInt);
begin
    init0(lb1,ub1);
    if maxsize>0 then
       Elements:=AllocMem(Maxsize*SizeOf(Complex));
end;

destructor TArray1C.destroy;
begin
  if elements<>nil then
     FreeMem(Elements,Maxsize*SizeOf(Complex));
  inherited destroy;
end;


constructor TArray1C.createCopy(a:TArray1C);
var
  i:NativeInt;
begin
   TArray.create;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Maxsize:=Size1;
   if maxsize>0 then
       begin
         Elements:=AllocMem(Maxsize*SizeOf(Complex));
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

function TArray1C.NewCopy:TArray1C;
begin
   result:=TArray1C.createCopy(self)
end;


procedure TArray2C.init(lb1,ub1,lb2,ub2:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2);
    if maxsize>0 then
       Elements:=AllocMem(Maxsize*SizeOf(Complex));
end;

destructor TArray2C.destroy;
begin
  if elements<>nil then
     FreeMem(Elements,Maxsize*SizeOf(Complex));
  inherited destroy;
end;

constructor TArray2C.createCopy(a:TArray2C);
var
i:NativeInt;
begin
   TArray.create;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Lbound2:=a.Lbound2;
   Size2:=a.Size2;
   Maxsize:=Size1*size2;
   if maxsize>0 then
       begin
         Elements:=AllocMem(Maxsize*SizeOf(Complex));
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

function TArray2C.NewCopy:TArray2C;
begin
   result:=TArray2C.createCopy(self)
end;

procedure TArray3C.init(lb1,ub1,lb2,ub2,lb3, ub3:NativeInt);
begin
    init0(lb1,ub1,lb2,ub2,lb3,ub3);
    if maxsize>0 then
       Elements:=AllocMem(Maxsize*SizeOf(Complex));
end;

destructor TArray3C.destroy;
begin
    if elements<>nil then
       FreeMem(Elements,Maxsize*SizeOf(Complex));
    inherited destroy;
end;
 constructor TArray3C.createCopy(a:TArray3C);
var
  i:NativeInt;
begin
   TArray.create;
   Lbound1:=a.Lbound1;
   Size1:=a.Size1;
   Lbound2:=a.Lbound2;
   Size2:=a.Size2;
   Lbound3:=a.Lbound3;
   Size3:=a.Size3;
   Maxsize:=Size1*size2*size3;
   if maxsize>0 then
       begin
         Elements:=AllocMem(Maxsize*SizeOf(Complex));
         for i:=0 to maxsize-1 do
             elements^[i]:=a.elements^[i];
       end;
end;

function TArray3C.NewCopy:TArray3C;
begin
   result:=TArray3C.createCopy(self)
end;





 procedure TArray4C.init(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4:NativeInt);
 begin
     init0(lb1,ub1,lb2,ub2,lb3,ub3,lb4,ub4);
     if maxsize>0 then
        Elements:=AllocMem(Maxsize*SizeOf(Complex));
 end;

 destructor TArray4C.destroy;
 begin
   if elements<>nil then
      FreeMem(Elements,Maxsize*SizeOf(Complex));
   inherited destroy;
 end;

 constructor TArray4C.createCopy(a:TArray4C);
 var
   i:NativeInt;
 begin
    TArray.create;
    Lbound1:=a.Lbound1;
    Size1:=a.Size1;
    Lbound2:=a.Lbound2;
    Size2:=a.Size2;
    Lbound3:=a.Lbound3;
    Size3:=a.Size3;
    Lbound4:=a.Lbound3;
    Size4:=a.Size4;
    Maxsize:=Size1*size2*size3*size4;
    if maxsize>0 then
        begin
          Elements:=AllocMem(Maxsize*SizeOf(Complex));
          for i:=0 to maxsize-1 do
              elements^[i]:=a.elements^[i];
        end;
 end;

 function TArray4C.NewCopy:TArray4C;
 begin
    result:=TArray4C.createCopy(self)
 end;


{**************}
{MAT OPERATIONS}
{**************}

procedure TArray1C.subst(a:TArray1C);
var
   i:NativeInt;
begin
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1);
   if a.size1>maxsize then setexception(5001);
   Size1:=a.Size1;
   for i:=0 to a.size1-1 do
       elements^[i]:=a.elements^[i]
end;

procedure TArray1C.subst(a:TArray2C);
var
   i:NativeInt;
begin
   if a.size1<>1 then setexception(6001);
   if MaxSize=0 then
      dim(a.Lbound2,a.lbound2+a.size2-1);
   if a.size2>maxsize then setexception(5001);
   Size1:=a.Size2;
   for i:=0 to a.size2-1 do
       elements^[i]:=a.elements^[i]
end;

procedure TArray1C.trn(a:TArray2C);           //aが縦ベクトルのとき用いる
var
   i:NativeInt;
begin
   if a.size2<>1 then setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1);
   if a.size1>maxsize then setexception(5001);
   Size1:=a.Size1;
   for i:=0 to a.size1-1 do
       elements^[i]:=a.elements^[i]
end;

procedure TArray1C.add(a,b:TArray1C);
var
   c:TArray1C;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray1C.create(1,a.size1);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]+b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;

procedure TArray1C.sub(a,b:TArray1C);
var
   c:TArray1C;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray1C.create(1,a.size1);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]-b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;

procedure TArray1C.prod(a:TArray1C; b:TArray2C); overload;
var
   i,j:NativeInt;
   c:TArray1C;
begin
   if a.size1<>b.size1 then setexception(6001);
   if MaxSize=0 then
      dim(b.lbound2,b.lbound2+b.size2-1);
   //if maxsize<b.size2 then setexception(5001);
   c:=TArray1C.create(1, b.size2);
   try
     for j:=0 to b.size2-1 do
       for i:=0 to b.size1 -1 do
         c.elements^[j]:=c.elements^[j]+ a.elements^[i]*b.elements^[i*b.size2+j];
     subst(c);
   finally
     c.free;
   end;

end;

procedure TArray1C.prod(a:TArray2C; b:TArray1C); overload;
var
   i,j:NativeInt;
   c:TArray1C;
begin
   if a.size2<>b.size1 then setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1);
   //if maxsize<a.size1 then setexception(5001);
   c:=TArray1C.create(1, a.size1);
   try
     for i:=0 to a.size1-1 do
       for j:=0 to a.size2 -1 do
         c.elements^[i]:=c.elements^[i]+ a.elements^[i*a.size2+j]*b.elements^[j];
     subst(c);
   finally
     c.free;
   end;
end;

procedure TArray1C.scalar(x:double; a:TArray1C);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray1C.scalar(x:complex; a:TArray1C);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray1C.CON(x:double);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray1C.CON(x:complex);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray1C.CON;
begin
  CON(1)
end;

procedure TArray1C.zer;overload;
var
   i:NativeInt;
begin
   for i:=0 to size1-1 do
      elements^[i]:=0;
end;

procedure TArray1C.zer(x:double);overload;
begin
   zer
end;

procedure TArray1C.zer(x:complex);overload;
begin
   zer
end;

procedure TArray1C.CROSSsub(a,b:TArray1C);
var
   i:NativeInt;
   x,y:complex;
begin
   for i:=0 to 2 do
     begin
       elements^[i mod 3]:=0;
       x:=a.elements^[(i+1) mod 3];
       x:=x*b.elements^[(i+2) mod 3];
       y:=b.elements^[(i+1) mod 3];
       y:=y*a.elements^[(i+2) mod 3];
       elements^[i mod 3]:=elements^[i mod 3]+x-y;
    end;
end;

procedure TArray1C.CROSS(a,b:TArray1C);
var
  c:TArray1C;
begin
   if (a.size<3) or (b.size<3) then setexception(6001);
   if MaxSize<3 then setexception(5001);
   c:=TArray1C.create(1,3);
   try
     c.CrossSub(a,b);
     subst(c);
   finally
     c.free;
   end;
end;
procedure TArray1C.row(a:TArray2C;n:integer);
var
  i:integer;
  x:complex;
begin
   if maxsize=0 then
      dim(1,a.size2);
   if maxsize<a.size2 then
          setexception(5001);
   size1:=a.size2;
   for i:=0 to size1 -1 do
       begin
         with a do
            x:=elements^[index(n,lbound2+i)];
         elements^[i]:=x;
       end;
end;

procedure TArray1C.column(a:TArray2C;n:integer);
var
  i:integer;
  x:complex;
begin
   if maxsize=0 then
      dim(1,a.size1);
   if maxsize<a.size1 then
          setexception(5001);
   size1:=a.size1;
   for i:=0 to size1 -1 do
       begin
         with a do
            x:=elements^[index(lbound1+i,n)];
         elements^[i]:=x;
       end;
end;

procedure TArray1C.row(a:TArray2C;n:complex);
begin
   row(a,System.Round(n.x))
end;

procedure TArray1C.column(a:TArray2C;n:complex);
begin
   column(a,System.Round(n.x))
end;

{********}
{TArray2C}
{********}


procedure TArray2C.subst(a:TArray2C);
var
   i:NativeInt;
begin
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1);
   if a.Size>MaxSize then
      setexception(5001);
   resize(a.size1,a.size2);
   for i:=0 to size-1 do
          elements^[i]:=A.elements^[i]

end;

procedure TArray2C.add(a,b:TArray2C);
var
   c:TArray2C;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1);
   //if a.Size>MaxSize then
   //   setexception(5001);
   c:=TArray2C.create(1, a.size1, 1, a.size2);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]+b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray2C.sub(a,b:TArray2C);
var
   c:TArray2C;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1);
   //if a.Size>MaxSize then
   //   setexception(5001);
   c:=TArray2C.create(1, a.size1, 1, a.size2);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]-b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;

procedure TArray2C.ProdSub(a:TArray2C; b:TArray2C);
var
  i,j,k:NativeInt;
begin
   for i:=0 to size1-1 do
      for j:=0 to size2-1 do
         for k:=0 to a.size2-1 do
            elements^[size2*i+j]:=elements^[Size2*i+j]+a.elements^[a.Size2*i+k]*b.elements^[b.size2*k+j];
end;

procedure TArray2C.prod(a:TArray2C; b:TArray2C);
var
  c:TArray2C;
  //i,j,k:NativeInt;
begin
   if (a.Size2<>b.Size1)  then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,b.Lbound2,b.lbound2+b.size2-1)
   else
      resize(a.size1, b.Size2);
   c:=TArray2C.create(1, a.size1, 1, b.size2);
   try
     c.ProdSub(a,b);
     subst(c);
   finally
     c.free;
   end;
end;

procedure TArray2C.INV(a:TArray2C);
var
   c:TArray2C;
begin
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1);
   c:=a.inverse;
   subst(c);
   c.free;
end;

procedure TArray2C.TRNSub(a:TArray2C);
var
   i,j:NativeInt;
begin
   for i:=0 to size1 -1 do
     for j:=0 to size2 -1 do
        elements^[j+size2*i]:=a.elements^[i+a.Size2*j];
end;

procedure TArray2C.TRN(a:TArray2C);
var
   c:TArray2C;
begin
   if MaxSize=0 then
      dim(a.lbound2,a.lbound2+a.size2-1,a.Lbound1,a.lbound1+a.size1-1)
   else
      resize(a.size2, a.size1);
   c:=TArray2C.create(1, a.Size2, 1, a.size1);
   c.TRNSub(a);
   subst(c);
   c.free;
end;

procedure TArray2C.TRN(a:TArray1C);       //2025/10/04 //ver.1.2.2.4
var
   i:nativeint;
begin
   if MaxSize=0 then
      dim(a.lbound,a.lbound+a.size-1,a.Lbound,a.lbound)
   else
      resize(a.size, 1);
   for i:=0 to size1 -1 do
        elements^[i]:=a.elements^[i];
end;

procedure TArray2C.scalar(x:double; a:TArray2C);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray2C.scalar(x:complex; a:TArray2C);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray2C.power(a:Tarray2C; x:double);
var
  a1:TArray2C;
  i,n:NativeInt;
begin
  if a.size1<>a.size2 then
     setexception(6001);
  if MaxSize=0 then
     dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound1,a.lbound1+a.size1-1);
  n:=system.Round(x);
  if n=0 then
       IDN
  else
    begin
      if n>0 then
          begin
            subst(a);
            for i:=2 to n do
                prod(self,a);
          end
       else
          begin
             n:=-n;
             a1:=TArray2C.create(1, a.Size2, 1, a.size1);
             a1:=a.inverse;
             subst(a1);
             for i:=2 to n do
                 prod(self,a1);
             a1.free;
          end ;
  end;
end;

procedure TArray2C.power(a:Tarray2C; x:complex);
begin
  if x.y<>0 then
     setexception(3000);
  power(a,x.x);
end;


procedure TArray2C.con;
begin
  CON(1)
end;

procedure TArray2C.con(x:double);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray2C.con(x:complex);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray2C.zer;overload;
var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      elements^[i]:=0;
end;

procedure TArray2C.zer(x:double);overload;
begin
   zer
end;

procedure TArray2C.zer(x:complex);overload;
begin
   zer
end;


procedure TArray2C.IDN;          overload;
begin
   IDN(1)
end;

procedure TArray2C.IDN(x:double);overload;
var
   i:NativeInt;
begin
   if size1<>size2 then setexception(6004);
   zer;
   for i:=0 to size1-1 do
       elements^[i+size2*i]:=x
end;

procedure TArray2C.IDN(x:complex);overload;
var
   i:NativeInt;
begin
   if size1<>size2 then setexception(6004);
   zer;
   for i:=0 to size1-1 do
       elements^[i+size2*i]:=x
end;

procedure TArray2C.row(a:TArray2C; m,n:integer);
var
  i,j:integer;
  x:Complex;
begin
   size1:=n-m+1;
   size2:=a.size2;
   if maxsize=0 then
       dim(1,size1,1,size2);
   for j:=0 to n-m do          //行
    for i:=0 to size2 -1 do    //列
      begin
         with a do
             x:=elements^[index(j+m,lbound2+i)];
          elements^[j*size2 + i  ]:=x;
      end;
 end;


procedure TArray2C.column(a:TArray2C; m,n:integer);
var
  i,j:integer;
  x:Complex;
begin
   size1:=a.size1;
   size2:=n-m+1;
   if maxsize=0 then
       dim(1,size1,1,size2);
   for j:=0 to n-m do          //列
    for i:=0 to size1 -1 do    //行
      begin
         with a do
             x:=elements^[index(lbound1+i,m+j)];
          elements^[i*size2 + j  ]:=x;
      end;
 end;

procedure TArray2C.SubstRow1(n:integer; a:TArray1C);
var
  i:integer;
  x:Complex;
begin
  if a.size1<>size2 then
     setexception(6001);
  for i:=0 to size2-1 do
      begin
        x:=a.elements^[i];
        elements^[index(n, lbound2+i)]:=x;
      end;
end;

procedure TArray2C.SubstColumn1(n:integer; a:TArray1C);
var
  i:integer;
  x:Complex;
begin
  if a.size1<>size1 then
     setexception(6001);
  for i:=0 to size1-1 do
      begin
        x:=a.elements^[i];
        elements^[index(lbound1+i, n)]:=x;
      end;
end;

procedure TArray2C.SubstRow2(m,n:integer; a:TArray2C);
var
  i,j,k,m0,n0:integer;
  x:Complex;
begin
  if a.size2<>size2 then
     setexception(6001);
  m0:=m-lbound1;         //0ベースの行位置(始まり)
  n0:=n-lbound1;         //0ベースの行位置(終わり）

  k:=a.size1-(n-m+1);    //増加する行数
  if (size1+k)*size2>maxsize then
     setexception(5001);

  if k>0 then
     begin
       //後方へ移す
      for j:=size1-1 downto n0+1  do                           //n0行以降を後方に移動
          for i:=0 to size2-1 do                                //j行全体をコピー
           begin
                x:=elements^[ j*size2 +i];                        // j行i列要素
                elements^[(j+k)*size2 +i]:=x;                  // (j+k)行i列要素にする
           end;
     end
  else if k<0 then
     begin
       //前方へ移す
        for j:=n0+1 to size1-1  do                            //n0行以降を前方に移動
           for i:=0 to size2-1 do
            begin
              x:=elements^[ j*size2 + i];                        // j行i列要素
               elements^[(j+k)*size2 +i]:=x;
            end;
    end;

  size1:=size1+k;          //新しい行数

  for j:=0 to a.size1-1  do                                  //aの各行(j行)に対し
    for i:=0 to size2-1 do                                //j行全体をコピー
      begin
        with a do
           x:=a.elements^[j*size2 + i ];                        // j行i列要素
        elements^[index(m+j, lbound2+i)]:=x;                 //(m+j)行i列要素
      end;

end;

procedure TArray2C.SubstColumn2(m,n:integer; a:TArray2C);
var
  i,j,k,m0,n0:integer;
  c:TArray2C;
  x:Complex;
begin
  if a.size1<>size1 then                //行数が一致するか？
     setexception(6001);

   m0:=m-lbound1;         //0ベースの行位置(始まり)
   n0:=n-lbound1;         //0ベースの行位置(終わり）

  k:=a.size2-(n-m+1);    //増加する列数
  if size1*(size2+k)>maxsize then
     setexception(5001);

  c:=TArray2C.create(lbound1,size1,lbound2,size2+k);
  try
      for j:=0 to c.size2-1 do
        for i:=0 to c.size1-1 do
          begin
             if j<m0 then
                   x:=elements^[i*size2+j]
             else if j<=n0+k then
                   with a do
                     x:=elements[i*size2+j-m0]
             else
                   x:=elements[i*size2+j-k];
             with c do
                      elements^[i*size2+j]:=x;
           end;
      subst(c);
   finally
      c.free;
   end;
end;

procedure TArray2C.row(a:TArray2C;m,n:Complex);
begin
  row(a,System.Round(m.x),System.Round(n.x))
end;

procedure TArray2C.column(a:TArray2C;m,n:Complex);
begin
  column(a,System.Round(m.x),System.Round(n.x))
end;

procedure TArray2C.SubstRow1(n:Complex; a:TArray1C);
begin
   SubstRow1(System.Round(n.x), a)
end;

procedure TArray2C.SubstRow2(m,n:Complex; a:TArray2C);
begin
   SubstRow2(System.Round(m.x),System.Round(n.x), a)
end;

procedure TArray2C.SubstColumn1(n:Complex; a:TArray1C);
begin
   SubstColumn1(System.Round(n.x), a)
end;

procedure TArray2C.SubstColumn2(m,n:Complex; a:TArray2C);
begin
   SubstColumn2(System.Round(m.x),System.Round(n.x), a)
end;

{********}
{TArray3N}
{********}
procedure TArray3C.subst(a:TArray3C);
var
   i:NativeInt;
begin
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1);
   if a.Size>MaxSize then
      setexception(5001);
   resize(a.size1,a.size2,a.size3);
   for i:=0 to size-1 do
          elements^[i]:=a.elements^[i]

end;

procedure TArray3C.add(a,b:TArray3C);
var
   c:TArray3C;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) or (a.Size3<>b.Size3)then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray3C.create(1, a.size1, 1, a.size2, 1, a.size3);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]+b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray3C.sub(a,b:TArray3C);
var
   c:TArray3C;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) or (a.Size3<>b.Size3)then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray3C.create(1, a.size1, 1, a.size2, 1, a.size3);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]-b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray3C.scalar(x:double; a:TArray3C);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray3C.scalar(x:complex; a:TArray3C);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray3C.con;
begin
  CON(1)
end;

procedure TArray3C.con(x:double);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray3C.con(x:complex);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray3C.zer;overload;
var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      elements^[i]:=0;
end;

procedure TArray3C.zer(x:double);overload;
begin
   zer
end;

procedure TArray3C.zer(x:complex);overload;
begin
   zer
end;



procedure TArray4C.subst(a:TArray4C);
var
   i:NativeInt;
begin
   if a.Size>MaxSize then
      setexception(5001);
   resize(a.size1,a.size2,a.size3,a.size4);
   for i:=0 to size-1 do
          elements^[i]:=a.elements^[i]

end;

procedure TArray4C.add(a,b:TArray4C);
var
   c:TArray4C;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) or (a.Size3<>b.Size3)
                                               or (a.Size4<>b.Size4)then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1,a.Lbound4,a.lbound4+a.size4-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray4C.create(1, a.size1, 1, a.size2, 1, a.size3, 1, a.size4);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]+b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray4C.sub(a,b:TArray4C);
var
   c:TArray4C;
   i:NativeInt;
begin
   if (a.Size1<>b.Size1) or (a.Size2<>b.Size2) or (a.Size3<>b.Size3)
                                               or (a.Size4<>b.Size4)then
      setexception(6001);
   if MaxSize=0 then
      dim(a.lbound1,a.lbound1+a.size1-1,a.Lbound2,a.lbound2+a.size2-1,
          a.Lbound3,a.lbound3+a.size3-1,a.Lbound4,a.lbound4+a.size4-1);
   if a.Size>MaxSize then
      setexception(5001);
   c:=TArray4C.create(1, a.size1, 1, a.size2, 1, a.size3, 1, a.size4);
   try
     for i:=0 to c.size-1 do
         c.elements^[i]:=a.elements^[i]-b.elements^[i];
     subst(c)
   finally
     c.free;
   end;
end;


procedure TArray4C.scalar(x:double; a:TArray4C);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray4C.scalar(x:complex; a:TArray4C);
var
  i:NativeInt;
begin
  subst(a);
  for i:=0 to size-1 do
     elements^[i]:=x*elements^[i]
end;

procedure TArray4C.con;
begin
  CON(1)
end;

procedure TArray4C.con(x:double);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray4C.con(x:complex);
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
     elements^[i]:=x
end;

procedure TArray4C.zer;overload;
var
   i:NativeInt;
begin
   for i:=0 to size-1 do
      elements^[i]:=0;
end;

procedure TArray4C.zer(x:double);overload;
begin
   zer
end;

procedure TArray4C.zer(x:complex);overload;
begin
   zer
end;
{*******}
{MAT I/O}
{*******}

procedure TArray1C.MatPrint(ch:tTextDevice; direction:integer);
var
   i:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
        if direction<>0 then ch.NewZone;
        ch.AppendStrV2(CStr(elements^[i])+' ')
     end;
   ch.newline;
   ch.newline;
end;

procedure TArray2C.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
          if direction<>0 then ch.NewZone;
          ch.AppendStrV2(CStr(elements^[i*size2 + j])+' ')
         end;
       ch.newline;
     end;
   ch.newline
end;

procedure TArray3C.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j,k:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
           for k:=0 to size3-1 do
              begin
                if direction<>0 then ch.NewZone;
                ch.AppendStrV2(CSTR(elements^[(i*size2 + j)*size3 + k ])+' ')
              end;
            ch.newline;
         end;
       ch.newline;
     end;
end;

procedure TArray4C.MatPrint(ch:tTextDevice; direction:integer);
var
   i,j,k,l:NativeInt;
begin
   ch.newlineifneed;
   for i:=0 to size1 -1 do
     begin
       for j:=0 to size2-1 do
         begin
           for k:=0 to size3-1 do
              begin
                for l:=0 to size4-1 do
                  begin
                    if direction<>0 then ch.NewZone;
                    ch.AppendStrV2(CSTR(elements^[((i*size2 + j)*size3 + k)*size4 +l ])+' ')
                  end;
                ch.newline;
              end;
            ch.newline;
         end;
       ch.newline;
     end;
end;

procedure TArray1C.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size1 -1 do
     begin
        if i>0 then
           ch.WriteSeparator(false);
        ch.AppendStrV2(testreal(elements^[i]))
     end;
end;

procedure TArray2C.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size2=0));  //2025.05.29
        ch.AppendStrV2(testreal(elements^[i]))
     end;
end;

procedure TArray3C.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size3=0)); //2025.05.29
        ch.AppendStrV2(testreal(elements^[i]))
     end;
end;

procedure TArray4C.MatWrite(ch:tTextDevice);
var
   i:NativeInt;
begin
   for i:=0 to size -1 do
     begin
        if i>0 then
           ch.WriteSeparator((ch.RecType=rcCSV) and (i mod size4=0)); //2025.05.29
        ch.AppendStrV2(testreal(elements^[i]))
     end;
end;

procedure TArray1C.Read(list:TStringList;var p:integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=baslibc.FloatVal(list.Strings[p]);
      inc(p)
    end;
end;

procedure TArray2C.Read(list:TStringList;var p:integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=baslibc.FloatVal(list.Strings[p]);
      inc(p)
    end;
end;

procedure TArray3C.Read(list:TStringList;var p:integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=baslibc.FloatVal(list.Strings[p]);
      inc(p)
    end;
end;

procedure TArray4C.Read(list:TStringList;var p:integer); //listのpの位置から読む
var
  i:NativeInt;
begin
  for i:=0 to size-1 do
   if p<list.count then
    begin
      elements^[i]:=baslibc.FloatVal(list.Strings[p]);
      inc(p)
    end;
end;

function TArray1C.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;

function TArray2C.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;

function TArray3C.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;

function TArray4C.kindlist:ansistring;
begin
  result:=StringOfChar('n',size);
end;

function TArray1C.InputDirective:string;
begin
    result:=StringOfChar('n',size1);
end;

function TArray2C.InputDirective:string;
begin
    result:=StringOfChar('n',size1*Size2);
end;

function TArray3C.InputDirective:string;
begin
    result:=StringOfChar('n',size1*Size2*Size3);
end;

function TArray4C.InputDirective:string;
begin
    result:=StringOfChar('n',size1*Size2*Size3*size4);
end;

procedure TArray1C.AssignVarilen(list:TstringList);
var
  i:NativeInt;
begin
  ReSize(list.count);
  with list do
    for i:=0 to Count-1 do
      elements^[i]:=baslibc.FloatVal(Strings[i]);
end;

{**********}
{ DOT & DET}
{**********}

function dot(a,b:TArray1C):complex;
var
   i:NativeInt;
begin
   if a.size1<>b.size1 then setexception(6001);
   result:=0;
   try
     for i:=0 to a.size-1 do
       result:=result+a.elements^[i]*conj(b.elements^[i])         //2012.4.6
   except
      on EOverFlow do
      begin
        {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
         raise EExtype.create(1009)
      end;
   end;
end;

function DET(a:TArray2C):complex;
begin
   a.Determinant(result)
end;

{**************}
{INVERSE MATRIX}
{**************}


procedure matinv(size:NativeInt; p:PcomplexArray;  pv:PIntArray; var det:complex);
{$MAXFPUREGISTERS 0}
  function a(i,j:NativeInt):Pcomplex;
  begin
     result:=@p^[i+j*size]
  end;
var
  i,j,k,tmp:NativeInt;
  t,u,temp:complex;
  eps:double;
label
  EXIT;
begin
  eps:=1; FEPS(eps); eps:=eps/2;
  for k:=0 to size-1 do pv^[k]:=k;
  det:=1;
  for k:=0 to size-1 do
     begin
        i:=k;
        while  (i<size) and (a(i,k)^=0.0) do inc(i);
        if i=size then
           begin det:=0.0; goto EXIT end
        else if i<>k then
           begin
              tmp:=pv^[i]; pv^[i]:=pv^[k]; pv^[k]:=tmp;
              for j:=0 to size-1 do
                  begin  temp:=a(i,j)^; a(i,j)^:=a(k,j)^; a(k,j)^:=temp end;
              det:=-det;
           end;

        t:=a(k,k)^;
        det:=det*t;
        for i:=0 to size-1 do
            a(k,i)^:=a(k,i)^/t;
        a(k,k)^:=1.0/t;
        for j:=0 to size-1 do
          if j<>k then
           begin
            u:=a(j,k)^;
            for i:=0 to k-1 do
                 begin
                   a(j,i)^:=a(j,i)^-a(k,i)^*u;
                 end;
            a(j,k)^:=-u/t;
            for i:=k+1 to size-1 do
                 begin
                   temp:=a(j,i)^-a(k,i)^*u;
                   if mathc.abs(temp)<mathc.abs(a(j,i)^)*EPS then temp:=0;
                   a(j,i)^:=temp;
                 end
           end;
     end;
  EXIT:
end;

procedure TArray2C.determinant(var n:complex);
{$MAXFPUREGISTERS 0}
var
  i,j:NativeInt;
  det:complex;
  a:PcomplexArray;
  pv:PIntArray;
begin
  if size1=size2 then
    begin
      getmem(pv,size1*sizeof(NativeInt));
      getmem(a,size1*size2*sizeof(complex));
         try
            for i:=0 to size1-1 do
              for j:=0 to size2-1 do
                a^[i+j*size1]:=elements^[i*size2+j];
            matinv(size1,a,pv,det);
            n:=det;
         finally
            freemem(a,size1*size2*sizeof(complex));
            freemem(pv,size1*sizeof(NativeInt));
         end
    end
  else
     setexception(6002);
end;

function TArray2C.inverse:TArray2C;
var
  i,j:NativeInt;
  det:complex;
  p:PcomplexArray;
  pv:PIntArray;
begin
   result:=nil;
   if size1=size2 then
   begin
     getmem(pv,size1*sizeof(NativeInt)+size1*size2*sizeof(complex));
     try
        try
            p:=@pv^[size1];
            for i:=0 to size1-1 do
              for j:=0 to size2-1 do
                p^[i+j*size1]:=elements^[i*size2+j];
            matinv(size1,p,pv,det);
            if det=0 then
               setexception(3009)
            else
              begin
                result:=NewCopy;
                if result=nil then
                   setexception(ArraySizeOverflow)
                else
                begin
                  try
                    for i:=0 to size1-1 do
                      for j:=0 to size2-1 do
                        result.elements^[i*size2+pv^[j]]:=p^[i+j*size1];
                  except
                    on EMathError do
                       begin
                      {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
                       end;
                    on EDivByZero do
                       begin
                      {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
                       end;
                  end;
                end;
              end;
        finally
            freemem(pv,size1*sizeof(NativeInt)+size1*size2*sizeof(complex));
        end
     except
           result.free;
           result:=nil;
           raise;
     end;
   end
  else
     setexception(6003);
end;

function TArray1C.Array1N:TArray1N;
var
   i:NativeInt;
begin
   result:=TArray1N.create(Lbound,Ubound);
   try
     for i:=0 to size1 -1 do
       result.elements^[i]:=testreal(elements^[i]);
   except
     result.free;
     result:=nil;
     raise;
   end;
end;

function TArray1C.Array2N:TArray2N;
var
   i:NativeInt;
begin
   result:=TArray2N.create(Lbound,Ubound, 0,1);
   try
     for i:=0 to size1 -1 do
       begin
          result.elements^[i*2]:=(elements^[i]).x;
          result.elements^[i*2+1]:=(elements^[i]).y;
       end;
   except
     result.free;
     result:=nil;
     raise;
   end;
end;


function TArray2C.Array2N:TArray2N;
var
   i:NativeInt;
begin
   result:=TArray2N.create(Lbound(1),Ubound(1), Lbound(2), Ubound(2));
   try
     for i:=0 to size - 1 do
       result.elements^[i]:=testreal(elements^[i]);
   except
     result.free;
     result:=nil;
     raise;
   end;
end;

procedure TArray1C.LetWithTrace(ch:tTextDevice; name: ansistring; index1:complex; value: complex);
begin
   elements^[index(index1)]:=value;
   if ch<>nil then
       ch.PRINT([],rsNone, false ,[' '+name+'('+Format17(SysIntRound(testreal(index1)))+')=',
                                                 TComplex.create(value), TNewLine.create]);
end;

procedure TArray2C.LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2:complex; value: complex);
begin
   elements^[index(index1,index2)]:=value;
   if ch<>nil then
       ch.PRINT([],rsNone, false ,[' '+name+'('+Format17(SysIntRound(testreal(index1)))+ ','+
                                            Format17(SysIntRound(testreal(index2)))+ ')=',
                                                TComplex.create(value), TNewLine.create]);
end;

procedure TArray3C.LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2,index3:complex; value: complex);
begin
   elements^[index(index1,index2,index3)]:=value;
   if ch<>nil then
       ch.PRINT([],rsNone, false ,[' '+name+'('+Format17(SysIntRound(testreal(index1)))+ ','+
                                            Format17(SysIntRound(testreal(index2)))+ ','+
                                            Format17(SysIntRound(testreal(index3)))+ ')=',
                                                 TComplex.create(value), TNewLine.create]);
end;

procedure TArray4C.LetWithTrace(ch:tTextDevice; name: ansistring; index1,index2,index3,index4:complex; value: complex);
begin
   elements^[index(index1,index2,index3,index4)]:=value;
   if ch<>nil then
       ch.PRINT([],rsNone, false ,[' '+name+'('+Format17(SysIntRound(testreal(index1)))+ ','+
                                            Format17(SysIntRound(testreal(index2)))+ ','+
                                            Format17(SysIntRound(testreal(index3)))+ ','+
                                            Format17(SysIntRound(testreal(index4)))+ ')=',
                                                 TComplex.create(value), TNewLine.create]);
end;

{********************}
{Writeto and ReadFrom}
{********************}

procedure TArray1C.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PComplexArray(p)^[i]:=elements^[i];
end;

procedure TArray1C.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PComplexArray(p)^[i];
end;


procedure TArray2C.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PComplexArray(p)^[i]:=elements^[i];
end;

procedure TArray2C.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PComplexArray(p)^[i];
end;


procedure TArray3C.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PComplexArray(p)^[i]:=elements^[i];
end;

procedure TArray3C.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PComplexArray(p)^[i];
end;


procedure TArray4C.WriteTo(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    PComplexArray(p)^[i]:=elements^[i];
end;

procedure TArray4C.ReadFrom(p:Pointer; size1:integer);
var
  i:integer;
begin
  if size1<Size then setexception(6301);
  for i:=0 to Size-1 do
    elements^[i] := PComplexArray(p)^[i];
end;

 procedure CCONJ(var x:complex);
begin
   x.y:=-x.y
end;

procedure TArray1C.conj(a:TArray1C);
var
  i:integer;
begin
  subst(a);
  for i:=0 to size-1 do
      CConj( elements^[i]);
end;

procedure TArray2C.conj(a:TArray2C);
var
  i:integer;
begin
  subst(a);
  for i:=0 to size-1 do
      CConj( elements^[i]);
end;

procedure TArray3C.conj(a:TArray3C);
var
  i:integer;
begin
  subst(a);
  for i:=0 to size-1 do
      CConj( elements^[i]);
end;

procedure TArray4C.conj(a:TArray4C);
var
  i:integer;
begin
  subst(a);
  for i:=0 to size-1 do
      CConj( elements^[i]);
end;
{*****************}
{Matrix operations}
{*****************}

function matrixIDN(a:TArray2C): TArray2C;   //aをIDNにする
begin
  result:=a;
  result.idn;
end;

function matrixIDN(a:TArray2C; x:double): TArray2C;
var
  i:integer;
begin
  i:=System.Round(x);
  result:=a;
  with result do
    begin
      if maxsize=0 then
         dim(1,i,1,i)
      else
         resize(i);
      idn;
    end;
end;

function matrixTRN(a,b:TArray2C): TArray2C;
begin
  result:=a;
  result.trn(b);
end;

function matrixTRN(a:TArray2C; b:TArray1C): TArray2C;
begin
  result:=a;
  result.trn(b);
end;


function matrixINV(a,b:TArray2C):Tarray2C;
begin
  result:=a;
  result.INV(b);
end;

function matrixCNJ(a,b:TArray1C):Tarray1C;
begin
  result:=a;
  result.conj(b);
end;

function matrixCNJ(a,b:TArray2C):Tarray2C;
begin
  result:=a;
  result.conj(b);
end;

function matrixCNJ(a,b:TArray3C):Tarray3C;
begin
  result:=a;
  result.conj(b);
end;

function matrixCNJ(a,b:TArray4C):Tarray4C;
begin
  result:=a;
  result.conj(b);
end;


function matrixPOWER(a,b:TArray2C; x:double):TArray2C;
begin
  result:=a;
  result.power(b,x);
end;

function matrixScalar(a:TArray1C; x:complex; b:TArray1C):TArray1C;
begin
  result:=a;
  result.scalar(x,b);
end;

function matrixScalar(a:TArray2C; x:complex; b:TArray2C):TArray2C;
begin
  result:=a;
  result.scalar(x,b);
end;

function matrixScalar(a:TArray3C; x:complex; b:TArray3C):TArray3C;
begin
  result:=a;
  result.scalar(x,b);
end;

function matrixScalar(a:TArray4C; x:complex; b:TArray4C):TArray4C;
begin
  result:=a;
  result.scalar(x,b);
end;

function matrixProd(a,b:TArray1C; c:TArray2C):TArray1C;
begin
  result:=a;
  result.prod(b,c);
end;

function matrixProd(a,b,c:TArray2C):TArray2C;
begin
  result:=a;
  result.prod(b,c);
end;

function matrixAdd(a,b,c:TArray1C):TArray1C;
begin
  result:=a;
  result.add(b,c);
end;

function matrixSbt(a,b,c:TArray1C):TArray1C;
begin
  result:=a;
  result.sub(b,c);
end;

function matrixAdd(a,b,c:TArray2C):TArray2C;
begin
  result:=a;
  result.add(b,c);
end;

function matrixSbt(a,b,c:TArray2C):TArray2C;
begin
  result:=a;
  result.sub(b,c);
end;

function matrixAdd(a,b,c:TArray3C):TArray3C;
begin
  result:=a;
  result.add(b,c);
end;

function matrixSbt(a,b,c:TArray3C):TArray3C;
begin
  result:=a;
  result.sub(b,c);
end;

function matrixAdd(a,b,c:TArray4C):TArray4C;
begin
  result:=a;
  result.add(b,c);
end;

function matrixSbt(a,b,c:TArray4C):TArray4C;
begin
  result:=a;
  result.sub(b,c);
end;















function matrixInit(a:TArray1C; args:array of const): TArray1C;
var
  i:integer;
  x:complex;
begin
 result:=a;
 with result do
   for i:=0 to size1-1 do
     begin
       with args[i] do
        case VType of
          vtObject:begin
                     if VObject is TComplex then
                          x:=TComplex(VObject).value;
                      VObject.free
                   end;
        end;
       elements^[i]:=x
     end;
end;

function matrixRow1(a:TArray1C; b:TArray2C; i:double):Tarray1C;
begin
  result:=a;
  result.row(b,System.Round(i));
end;

function matrixColumn1(a:TArray1C;b:TArray2C; i:double):Tarray1C;
begin
  result:=a;
  result.Column(b,System.Round(i));
end;

function matrixRow2(a:TArray2C; b:TArray2C; i,j:double):Tarray2C;
begin
  result:=a;
  result.row(b,System.Round(i),System.Round(j));
end;

function matrixColumn2(a:TArray2C; b:TArray2C; i,j:double):Tarray2C;
begin
  result:=a;
  result.Column(b,System.Round(i),System.Round(j));
end;
end.

