Borland DelphiからNAGライブラリを利用

DelphiからNAG Fortran ライブラリDLLを呼び出す際の1つの注意点として、実引数がvar型である必要がある点があげられます。これはFortranの呼び出し規約が引数の参照渡しを必要としているからです。DelphiではNAG Fortran ライブラリDLL内のルーチンを直接コードないから呼び出すことによりコンパイラが自動的にリンクしてくれます。そのためコンパイル時のリンクリストにNAGライブラリを指定する必要はありません。

NAG Fortran ライブラリDLLへの参照は、Delphiではexternalなprocedureもしくはfunctionとして定義されます。ここでのprocedureはDLL内のルーチンと同じ名前にする必要があります。Delphiは大文字小文字の区別をするため、NAG FortranライブラリDLLルーチン名は大文字で指定してください。(Delphiのname constructを使って変更することは可能です)

以下の例をまずご覧ください:

  function S18AEF(var X : Double;
                  var IFAIL : Integer): Double;
                  stdcall;
                  external 'nagsx.dll'; 

stdcall指示子の指定を行ってください。NAG Fortran ライブラリDLLはこの呼び出し規約で呼び出す必要があります。この指定によりNAG FortranライブラリDLL内の関数もしくはサブルーチンは通常のfunctionもしくはprocedureとして呼び出すことが可能です。以下はその一例です。

  WriteLn(S18AEF(X, IFAIL))

多次元配列

2次元以上の配列は転置する必要があります。これはNAG FortranライブラリDLLがFortranの配列順序(colamn major)を受けるからです。例えばA[2,2]はメモリ上では A[1,1], A[2,1], A[1,2], A[2,2]の順序で保持されます。Pascalではこの列と行の順序が逆(row major)になり、メモリ上ではA[1,1], A[1,2], A[2,1], A[2,2]の順序で保持されます。Pascalの配列は実引数としてNAG FortranライブラリのDLLに渡されるので、下記の「D03PCF Example」で示されるように、データタイプとして定義する必要があります。varセクションで定義されるPascal変数配列が実引数として渡されると他のパラメータ値を上書きしてしまいます。 多次元配列の扱いについては「D03PCF Example」をご参照ください。

関数と手続きのを渡す

一部のNAGライブラリルーチンは、関数もしくはサブルーチンを引数として受け取ります。これをDelphiで行う場合には引数として渡すprocedureもしくはfunctionをtype headingで定義される1つのデータタイプとして指定する必要があります。これによりパラメータリストとしてDLLに渡すことが可能になります。型定義においてサブルーチンが持つ引数の数と型が一致している必要があります。ここでvarは必要ないことに注意して下さい。これは引き渡しの際に1つのコピーしか必要とされないからです。またstdcallの指定がfunction/procedure定義とデータ型定義の両方に必要である点にも注意して下さい。

DelphiによるD03PCF Example

以下の例はNAG FortranライブラリDLL内のルーチンD03PCFを呼び出すものです。このルーチンは線形もしくは非線形の連立PDEを解くものです。下記のプログラムでは多次元配列の使用方法と引数としての関数の渡し方が示されます。更に外部関数としてX01AAFを用いてπを得ています。

 unit D03Code;
 
 interface
 
 uses
  Windows, Messages, SysUtils, Classes, Graphics,
 Controls, TForms,  Dialogs;
 
 type
  TForm1 = class(TForm)
  private
   { Private declarations }
    public
      { Public declarations }
    end;
  
  var
   TForm1: TForm1;
  
  implementation
  
  {$R *.DFM} {Compiler Directive}
  type
     U_ArrayType = array [1..20, 1..2] of Double;
     UOUT_ArrayType = array [1..1, 1..6, 1..2] of Double;
     {Note: the two arrays above are defined as the transpose of the
            parameter requirements to ensure compatibility with Fortran DLLs.}
  
     W_ArrayType = array [1..1128] of Double; {1..NW}
     X_ArrayType = array [1..20] of Double; {1..NPTS}
     XOUT_ArrayType = array [1..6] of Double; {1..INTPTS}
     IW_ArrayType = array [1..64] of Integer; {1..NIW}
     NPDE_ArrayType = array [1..2] of Double; {1..NPDE}
     P_ArrayType = array [1..2] of NPDE_ArrayType;
     PDEDEFType = Procedure(var NPDE : Integer;
                            var T : Double;
                            var X : Double;
                            var U : NPDE_ArrayType;
                            var DUDX : NPDE_ArrayType;
                            var P : P_ArrayType;
                            var Q : NPDE_ArrayType;
                            var R : NPDE_ArrayType;
                            var IRES : Integer);
                            stdcall;
     BNDARYType = Procedure(var NPDE : Integer;
                            var T : Double;
                            var U : NPDE_ArrayType;
                            var UX : NPDE_ArrayType;
                            var IBND : Integer;
                            var BETA : NPDE_ArrayType;
                            var GAMMA : NPDE_ArrayType;
                            var IRES : Integer);
                            stdcall;

{The two types above are Procedure types. }

  var
     NPDE : Integer = 2;
     NPTS : Integer = 20;
     INTPTS : Integer = 6;
     ITYPE : Integer = 1;
     NEQN : Integer;
     NIW : Integer;
     NWK : Integer;
     NW : Integer;
  
     I : Integer;
     J : Integer;
     IFAIL : Integer;
  
     ALPHA : Double;
     ACC : Double;
     HX : Double;
     PI : Double;
     PIBY2 : Double;
     TOUT : Double;
     TS : Double;
     IND : Integer;
     IT : Integer;
     ITASK : Integer;
     ITRACE : Integer;
     M : Integer;
     U : U_ArrayType;
     UOUT : UOUT_ArrayType;
     W : W_ArrayType;
     X : X_ArrayType;
     XOUT : XOUT_ArrayType = (0.0,0.4,0.6,0.8,0.9,1.0);
     IW : IW_ArrayType;
  
  Procedure D03PCF(var NPDE : Integer;
                   var M : Integer;
                   var TS : Double;
                   var TOUT : Double;
                   PDEDEF : PDEDEFType; {The two procedure parameters,}
                   BNDARY : BNDARYType; {defined above under type}
                   var U : U_ArrayType;
                   var NPTS : Integer;
                   var X : X_ArrayType;
                   var ACC : Double;
                   var W : W_ArrayType;
                   var NW : Integer;
                   var IW : IW_ArrayType;
                   var NIW : Integer;
                   var ITASK : Integer;
                   var ITRACE : Integer;
                   var IND : Integer;
                   var IFAIL : Integer);
                   stdcall;
                   external 'nagD03.dll';
  
  Function X01AAF(var PI : Double) : Double; stdcall;
  external 'nagsx.dll';
  
  Procedure D03PZF(var NPDE : Integer;
                   var M : Integer;
                   var U : U_ArrayType;
                   var NPTS : Integer;
                   var X : X_ArrayType;
                   var XOUT : XOUT_ArrayType;
                   var INTPTS : Integer;
                   var ITYPE : Integer;
                   var UOUT : UOUT_ArrayType;
                   var IFAIL : Integer);
                   stdcall;
                   external 'nagD03.dll';
  
  {PDEDEF - to define the system of PDEs}
  
  Procedure PDEDEF(var NPDE : Integer;
                   var T : Double;
                   var X : Double;
                   var U : NPDE_ArrayType;
                   var UX : NPDE_ArrayType;
                   var P : P_ArrayType;
                   var Q : NPDE_ArrayType;
                   var R : NPDE_ArrayType;
                   var IRES : Integer);
                   stdcall;
     begin
     Q[1] := 4.0*ALPHA*(U[2]+X*UX[2]);
     Q[2] := 0.0;
     R[1] := X*UX[1];
     R[2] := UX[2]-U[1]*U[2];
     P[1,1] := 0;
     P[1,2] := 0;
     P[2,1] := 0;
     P[2,2] := 1.0-X*X
     end;
  
  Procedure BNDARY(var NPDE : Integer;
                   var T : Double;
                   var U : NPDE_ArrayType;
                   var UX : NPDE_ArrayType;
                   var IBND : Integer;
                   var BETA : NPDE_ArrayType;
                   var GAMMA : NPDE_ArrayType;
                   var IRES : Integer);
                   stdcall;
     begin
     if (IBND=0) then
        begin
        BETA[1] := 0;
        BETA[2] := 1;
        GAMMA[1] := U[1];
        GAMMA[2] := -U[1]*U[2];
        end
     else
        begin
        BETA[1] := 1;
        BETA[2] := 0;
        GAMMA[1] := -U[1];
        GAMMA[2] := U[2];
        end
     end;
  
  Procedure SetUp;
     var
        I : Integer;
     begin
     NEQN := NPDE * NPTS;
     NIW := NEQN+24;
     NWK := (10+6*NPDE)*NEQN;
     NW := NWK+(21+3*NPDE)*NPDE+7*NPTS+54;
  
     ACC := 1.0E-4;
     M := 1;
     ITRACE := 0;
     ALPHA := 1.0;
     IND := 0;
     ITASK := 1;
  
     {Set spatial mesh points}
     PIBY2 := 0.5*X01AAF(PI);
     HX := PIBY2/(NPTS-1);
     X[1] := 0;
     X[NPTS] := 1;
     for I := 2 to (NPTS-1) Do
       begin
       X[I] := SIN(HX*(I-1))
       end;
  
     {Set initial conditions}
     TS := 0.0;
     TOUT := 0.1E-4;
     end;
  
  {Uinit defines the initial PDE condition}
  
  Procedure Uinit(var U : U_ArrayType;
                  var X : X_ArrayType;
                  var NPTS : Integer);
     var
        I : Integer;
     begin
     for I := 1 to NPTS Do
        begin
        U[I,1] := 2.0*ALPHA*X[I];
        U[I,2] := 1.0;
        end;
     end;
  
  begin
     WriteLn('D03PCF - Example program results');
     SetUp;
     WriteLn;
     WriteLn('Accuracy requirement = ',ACC);
     WriteLn('Parameter alpha = ',ALPHA);
     Write('  T  /  X  ');
     for I := 1 to 6 Do
        Write(XOUT[I] : 6);
     WriteLn;
  
     Uinit(U,X,NPTS);
     for I := 1 to 5 Do
        begin
        IFAIL := -1;
        TOUT := 10*TOUT;
  
  D03PCF(NPDE,M,TS,TOUT,PDEDEF,BNDARY,U,NPTS,X,ACC,W,NW,IW,N
  IW,
              ITASK,ITRACE,IND,IFAIL);
  
  D03PZF(NPDE,M,U,NPTS,X,XOUT,INTPTS,ITYPE,UOUT,IFAIL);
        WriteLn;
        Write(TOUT : 6,' U[1]');
        for J := 1 to INTPTS Do
           Write(UOUT[1,J,1] : 5,' ');
        WriteLn;
        Write('           U[2]');
        for J := 1 to INTPTS Do
           Write(UOUT[1,J,2] : 5,' ');
        WriteLn;
        end;
     WriteLn('Number of integration steps in time',IW[1]);
     WriteLn('Number of residual evaluations of resulting ODE
  system ',IW[2]);
     WriteLn('Number of Jacobian evaluations',IW[3]);
     WriteLn('Number of interations of nonlinear solver',IW[5]);
  end.
    

文字列の扱い、および渡し方

いくつかのNAG Fortran ライブラリ内のルーチンは文字もしくは文字列を引数として受け取ります。文字列はnullで終端している必要があります。文字列はPcharもしくは以下のように文字配列として定義して下さい。

  strng  =  array  [ 0 . . 2 ]  of  Char ;

以下の例では文字列配列を使います。配列は0ベース(0から始まる)である必要があります。NAG Fortran ライブラリDLLは0ベース以外の配列ではエラーになります。

またNAG Fortran ライブラリDLLは文字列引数の直後に文字列長を受け取ります。そのため文字列の次にintegerパラメータで文字列長を渡して下さい。以下はその例です。

  procedure G02EEF(...;
                   ...;
                       var NAME : Strng_ArrayType;
                       NAME_Len : Integer;
                       ...;
                       var NEWVAR : Strng;
                       NEWVAR_Len : Integer;
                       ...);
                       stdcall;
                       external 'nagG02.dll';

そしてその呼び出し方法です。

  G02EEF(..., ..., NAME, 3, ..., NEWVAR, 3, ...);

これらの文字列長の引数はcharacterやStrng_ArrayTypeなどの文字列配列の後に必要です。

DelphiによるG02EEF Example

下記の例はNAG FortranライブラリルーチンのG02EEFを用いて前方選択手続により最適な線形回帰モデルを見つけ出すものです。この例では文字列を渡す際の問題と多次元配列の扱いが示されます。

  unit G02Code;
  
  interface
  
  uses
    Forms;
  
  type
    TForm1 = class(TForm)
    private
      { Private declarations }
    public
      { Public declarations }
    end;
  
  var
    Form1: TForm1;
  
  implementation
  
  {$R *.DFM}
  {G02EEF - Example Program in Delphi 2}
  
  type
     X_ArrayType = array [1..8, 1..20] of Double;
    {X Array, and Q Array below, are defined as the transpose of the parameter 
     requirements to ensure compatibility with Fortran DLL.}
     Strng = array [0..2] of Char;
     {A Null terminated string. Note the zero basing of the array 
		 of characters.}
     Strng_ArrayType = array [1..8] of Strng;
     ISX_ArrayType = array [1..8] of Integer;
     WTY_ArrayType = array [1..20] of Double;
     EP_ArrayType = array [1..9] of Double;
     Q_ArrayType = array [1..10, 1..20] of Double;
     WK_ArrayType = array [1..16] of Double;
  
   var
     I : Integer;
     J : Integer;
     NMAX : Integer = 20;
     MMAX : Integer = 8;
     ISTEP : Integer;
     MEAN : Char;
     WEIGHT : Char;
     N : Integer;
     M : Integer;
     X : X_ArrayType;
     NAME : Strng_ArrayType;
     ISX : ISX_ArrayType;
     Y : WTY_ArrayType;
     WT : WTY_ArrayType;
     FIN : Double;
     ADDVAR : Boolean;
     CHRSS : Double;
     F : Double;
     MODEL : Strng_ArrayType;
     NTERM : Integer;
     RSS : Double;
     IDF : Integer;
     IFR : Integer;
     FREE : Strng_ArrayType;
     EXSS : EP_ArrayType;
     Q : Q_ArrayType;
     LDQ : Integer;
     P : EP_ArrayType;
     WK : WK_ArrayType;
     IFAIL : Integer;
     NEWVAR : Strng;
  
  Procedure G02EEF(var ISTEP : Integer;
                   var MEAN : Char;
                   MEANL : Integer;
                   var WEIGHT : Char;
                   WL : Integer;
                   var N : Integer;
                   var M : Integer;
                   var X : X_ArrayType;
                   var LDX : Integer;
                   var NAME : Strng_ArrayType;
                   NAME_L : Integer;
                   var ISX : ISX_ArrayType;
                   var MAXIP : Integer;
                   var Y : WTY_ArrayType;
                   var WT : WTY_ArrayType;
                   var FIN : Double;
                   var ADDVAR : Boolean;
                   var NEWVAR : Strng;
                   NVAR_L : Integer;
                   var CHRSS : Double;
                   var F : Double;
                   var MODEL : Strng_ArrayType;
                   MODL_L : Integer;
                   var NTERM : Integer;
                   var RSS : Double;
                   var IDF : Integer;
                   var IFR : Integer;
                   var FREE : Strng_ArrayType;
                   FREE_L : Integer;
                   var EXSS : EP_ArrayType;
                   var Q : Q_ArrayType;
                   var LDQ : Integer;
                   var P : EP_ArrayType;
                   var WK : WK_ArrayType;
                   var IFAIL : Integer);
                   stdcall;
                   external 'nagG02.dll';
  
  Procedure R;
     var
        Temp : Char;
     begin
     Read(Temp);
     end;
  
  Procedure ReadData;
     var
        I : Integer;
        J : Integer;
  
     begin
     ReadLn; {Skip heading in datafile}
     Read(N, M);
     R; {Skip blank space - See subroutine above}
     Read(MEAN,WEIGHT);
     If (M<MMAX) and (N<=NMAX) then
        begin
        for I := 1 to N Do
           begin
           for J := 1 to M Do
              begin
              Read(X[J,I]);
              end;
           Read(Y[I]);
           If (WEIGHT='W') or (WEIGHT='w') then
              Read(WT[I]);
           end;
        end;
     R;
     for J := 1 to M Do
        begin
        Read(ISX[J]);
        end;
     R;
     for I := 1 to M Do
        begin
        for J := 0 to 2 Do {note the zero basing of the array and loop}
           begin
           Read(NAME[I,J]);
           end;
        R;
        end;
     Read(FIN);
     end;
  
  Procedure FreeVars;
     begin
     Write('Free variables:  ');
        for J := 1 to IFR Do
           begin
           Write(FREE[J]);
           Write(' ');
           end;
        WriteLn;
        WriteLn('Change in residual sum of squares for free variables:');
        for J := 1 to IFR Do
           begin
           Write(EXSS[J]);
           Write('   ');
           end;
        WriteLn;
        WriteLn;
     end;
  
  begin
     WriteLn('G02EEF Example Program Results');
     ISTEP := 0;
     IFAIL := 0;
     ReadData;
     for I:=1 to M Do
        begin
        IFAIL:=0;
  
  G02EEF(ISTEP,MEAN,1,WEIGHT,1,N,M,X,NMAX,NAME,3,ISX,MMAX,Y,WT,
  FIN,ADDVAR,NEWVAR,3,CHRSS,F,MODEL,3,NTERM,RSS,IDF,
               IFR,FREE,3,EXSS,Q,NMAX,P,WK,IFAIL);
  {NB Fortran requires the length of the strings to be passed immediately 
	following the strings themselves.
        Therefore it expects an integer after every string parameter.}
        if (IFAIL<>0) then
           begin
           WriteLn('IFAIL = ',IFAIL);
           Exit;
           end;
        WriteLn;
        WriteLn('Step ',ISTEP);
        if (ADDVAR<>TRUE) then
           begin
           WriteLn('No further variables added maximum F =',F);
           FreeVars;
           Exit;
           end
        else
           begin
           WriteLn('Added variable is ',NEWVAR);
           WriteLn('Change in residual sum of squares =',CHRSS);
           WriteLn('F Statistic = ',F);
           WriteLn;
           Write('Variables in model: ');
           for J := 1 to NTERM Do
              begin
              Write(MODEL[J]);
              Write(' ');
              end;
           WriteLn;
           WriteLn;
           WriteLn('Residual sum of squares = ',RSS);
           WriteLn('Degrees of freedom = ',IDF);
           WriteLn;
           if (IFR=0) then
              begin
              WriteLn('No free variables remaining');
              Exit;
              end;
              FreeVars;
           end;
        end;
  end.
    


MENU
Privacy Policy  /  Trademarks