NAG DLLs 与 Delphi
当您要从 Delphi 中调用 NAG 函数时，需要特别注意的一点是实际的参数必须是 var 型态。这是因为 Fortran 调用协议是以 reference 方式传递而非不是 value。您并不需要在编译过程将 NAG 算法库加入 Delphi，DLL 能够直接被程序本身调用且编译器会自动链接。
参照到 DLL 的方式是透过 procedure 或 function，并在 Delphi 的程序中以 external 方式来定义。函数必须与 DLL 中将被调用的 NAG 函数名称相同。Delphi 是区分大小写的，因此 NAG 的函数名称必须以大写表示。
参考以下的例子：
function S18AEF(var X : Double;
var IFAIL : Integer): Double;
stdcall;
external 'nagsx.dll';
其中的 stdcall 指令是用来指定使用到的函数，Fortran 的 DLL 函数必须以此方式调用。所以 NAG 函数可以透过以下的方式进行调用：
WriteLn(S18AEF(X, IFAIL));
多维度数组
若要将多维的数组传递到 Fortran DLL 中，必须要将数组进行转换。这是因为 Fortran 语言的数组型态储存形式与 Delphi 不同，例如 A[2,2] 以列为主的连续位置方式储存，其连续位置是 A[1,1], A[2,1], A[1,2], A[2,2]。 但是，对 Pascal 来说，储存方式是以行为主的型态，则是以 A[1,1], A[1,2], A[2,1], A[2,2] 为连续值。 请注意在例子中，Pascal 的数组做为一个实际传递到 Fortran DLL 函数的参数时，必须定义为资料型别。 Pascal 的数组变量是在 var 中所定义的，若以实际的参数覆盖其他的参数值，将会导致系统出错。
传递 Functions 与 Procedures
许多的 NAG 函数在被调用时是需要用户传递函数作为其输入的参数。 为了要能在 Delphi 中传递，每个要被调用的 procedure 或 function 必须要有自己的资料型态，并在 type 区块中被定义。 这样便能够将一系列的参数传递到 DLL 中。型别的定义必须要有函数本身有相同的数量与型态。 请注意，并不需要 var 的定义，因为在传递过程中只有一个副本。另外，stdcall 必须在 function/procedure 的定义中或在资料型别的定义中使用的，用来确保符合正确的调用方式。
以 Delphi 调用 D03PCF 函数示例
以下程序调用 NAG D03PCF 函数，用来计算线性或非线性拋物线偏微分方程 (PDEs)。可以在 NAG 的 DLL NAGD03.DLL 中找到。 此程序说明如何使用多维度数组并如所述传递 function/procedure。请注意此示例为了取得 Phi 值同时也调用到 X01AAF 函数，可在 NAGSX.DLL 中找到。
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;
{请注意：以上的两个数组必须要定义成转置的型态，以确保调用 Fortran DLL 时能够兼容。}
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;
{以上的两个 types 是 Procedure 型别。必须要将 BNDARY 与 PDEDEF 定义成此型态，才能以参数方式传递 procedure 到 DLL 中。}
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.
字符串处理与传递
许多的 Fortran DLLs 函数需要输入字符串或是字符。字符串必须要以 null 结束，并且定义为 Pchar 或是字符数组：
strng = array [ 0 . . 2 ] of Char ;
示例程序中我们采用字符数组。请注意，数组起始位置是 0 开始。NAG 的 DLL 函数会预期字符串数组以 0 开始。
函数会要求在字符串传递时提供此字符串的长度。要做到这点最好的方法就是当传递字符串时，紧接着再传递另一个额外的整数参数表明字符串的长度。
例如：
procedure G02EEF(...;
...;
var NAME : Strng_ArrayType;
NAME_Len : Integer;
...;
var NEWVAR : Strng;
NEWVAR_Len : Integer;
...);
stdcall;
external 'nagG02.dll';
调用方式：
G02EEF(..., ..., NAME, 3, ..., NEWVAR, 3, ...);
增加了额外的参数，因为在字符串后会紧跟着整数表明字符串的长度。
Delphi 调用 G02EEF 示例
此示例调用 G02EEF 计算 forward selection 的线性回归模型。我们选择此例子说明传递字符串到 Fortran DLL 的方法。其中也包含多维度数组处理。
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);
{Fortran DLL 需要知道传递字符串的长度。因此，需要在每个字符串后接着提供字符串长度的整数值。}
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.