DelphiからnAG Fortran ライブラリDLLを呼び出す際の１つの注意点として、実引数が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))
多次元配列
２次元以上の配列は転置する必要があります。これは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で定義される１つのデータタイプとして指定する必要があります。これによりパラメータリストとしてDLLに渡すことが可能になります。型定義においてサブルーチンが持つ引数の数と型が一致している必要があります。ここでvarは必要ないことに注意して下さい。これは引き渡しの際に１つのコピーしか必要とされないからです。また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 ;
以下の例では文字列配列を使います。配列は０ベース（０から始まる）である必要があります。nAG Fortran ライブラリDLLは０ベース以外の配列ではエラーになります。
また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.