unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;

type
  TForm1 = class(TForm)
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
type complex = record
    real: Single;
    imag: Single;
end;
type dcomplex = record
    real: Double;
    imag: Double;
end;

procedure s_pastix(pastix_data: Pointer;
                   mpi_comm: Integer;
                   n: Integer;
                   colptr: array of Integer;
                   rows: array of Integer;
                   values: array of Single;
                   perm: array of Integer;
                   invp: array of Integer;
                   rhs: array of Single;
                   nrhs: Integer;
                   iparm: array of Integer;
                   dparm: array of Double); cdecl;
         external 'libpastix';

procedure d_pastix(pastix_data: Pointer;
                   mpi_comm: Integer;
                   n: Integer;
                   colptr: array of Integer;
                   rows: array of Integer;
                   values: array of Double;
                   perm: array of Integer;
                   invp: array of Integer;
                   rhs: array of Double;
                   nrhs: Integer;
                   iparm: array of Integer;
                   dparm: array of Double); cdecl;
         external 'libpastix';

procedure c_pastix(pastix_data: Pointer;
                   mpi_comm: Integer;
                   n: Integer;
                   colptr: array of Integer;
                   rows: array of Integer;
                   values: array of complex;
                   perm: array of Integer;
                   invp: array of Integer;
                   rhs: array of complex;
                   nrhs: Integer;
                   iparm: array of Integer;
                   dparm: array of Double); cdecl;
         external 'libpastix';

procedure z_pastix(pastix_data: Pointer;
                   mpi_comm: Integer;
                   n: Integer;
                   colptr: array of Integer;
                   rows: array of Integer;
                   values: array of dcomplex;
                   perm: array of Integer;
                   invp: array of Integer;
                   rhs: array of dcomplex;
                   nrhs: Integer;
                   iparm: array of Integer;
                   dparm: array of Double); cdecl;
         external 'libpastix';

implementation
var
  pastix_data : Pointer;
  mpi_comm : Integer;
  n : Integer;
  colptr : Array of Integer;
  rows: Array of Integer;
  values: Array of Single;
  perm, invp: Array of Integer;
  rhs: Array of Single;
  rhssave: Array of Single;
  Ax: Array of Single;
  nrhs: Integer;
  iparm: Array of Integer;
  dparm: Array of Double;
  norm1: Single;
  norm2: Single;
  i, j: Integer;
begin
  pastix_data := NIL;
  mpi_comm := 0;
  n := 4;
  nrhs := 1;
  SetLength(colptr, n+1);
  for i := 0 to n-1 do
  begin
        colptr[i] := 1+2*i;
  end;
  colptr[n] := 2*n;
  SetLength(rows, colptr[n]-1);
  SetLength(values, colptr[n]-1);
  SetLength(rhs, n);
  j := 0;
  for i := 0 to n-1 do
  begin
         rows[j] := i+1;
         values[j] := 2.;
         j := j+1;
         if i < n-1 then
         begin
           rows[j] := i+2;
           // in complex -1 + 2i
           values[j] := -1;
           j := j + 1;
         end;
         // -4 -4i in complex
         rhs[i] := 0;
  end;
  rhs[0] := 1;
  rhs[n-1] := 1;

  SetLength(perm, n);
  SetLength(invp, n);
  SetLength(iparm, 128);
  SetLength(dparm, 64);

  // Initialize parameters
  iparm[0] := 0;
  s_pastix(addr(pastix_data),
           mpi_comm,
           n,
           colptr,
           rows,
           values,
           perm,
           invp,
           rhs,
           nrhs,
           iparm,
           dparm);
  //* Set some parameters and call PaStiX */
  //* iparm[IPARM_THREAD_NBR] := 1; */
  iparm[34] := 1;
  //* iparm[IPARM_SYM] := API_SYM_YES; */
  iparm[40] := 0;
  //* iparm[IPARM_FACTORIZATION] := API_FACT_LDLT; */
  iparm[30] := 1;
  //* iparm[IPARM_START_TASK] := API_TASK_ORDERING; */
  iparm[1] := 1;
  //* iparm[IPARM_END_TASK] = API_TASK_CLEAN */
  iparm[2] := 7;

  SetLength(rhssave, n);
  for i := 0 to n-1 do
  begin
       rhssave[i] := rhs[i];
  end;

  s_pastix(addr(pastix_data),
           mpi_comm,
           n,
           colptr,
           rows,
           values,
           perm,
           invp,
           rhs,
           nrhs,
           iparm,
           dparm);
  SetLength(Ax, n);
  for i := 0 to n-1 do
  begin
       Ax[i] := 0;
  end;
  for i := 0 to n-1 do
  begin
       for j := colptr[i]-1 to colptr[i+1]-2 do
       begin
            Ax[rows[j]-1] := Ax[rows[j]-1] + values[j]*rhs[i];
            if i <> rows[j] - 1    then
            begin
                 Ax[i] := Ax[i] + values[j]*rhs[rows[j]-1];
            end;
       end;
  end;
  norm1 := 0;
  norm2 := 0;
  for i := 0 to n-1 do
  begin
       norm1 :=  norm1 + (Ax[i] - rhssave[i])*(Ax[i] - rhssave[i]);
       norm2 :=  rhssave[i]*rhssave[i];
       //ShowMessageFmt('AX[%d] %g sol %g rhssave %g', [i, Ax[i], rhs[i], rhssave[i]]);
  end;
  ShowMessageFmt('Precision : ||ax -b||/||b|| = %g', [sqrt(norm1/norm2)]);

{$R *.lfm}

end. 
