NAG Logo
Numerical Algorithms Group

NAG DLLs and Borland Delphi

One important point to bear in mind when calling the NAG DLLs from Delphi is that the actual parameters must be of type var. This is because the Fortran calling convention requires parameters to be passed by reference and not by value. It is not necessary to include the library itself in the compilation linker list in Delphi; the DLL can be called straight from the code itself and the compiler will link it automatically.

The reference to the DLL is as a procedure or function, defined as external in the Delphi code. This procedure needs to have the same name as the DLL routine called. Delphi is case sensitive, so the NAG name must be in capital letters (the Delphi name construct may be used to change this if desired).

Consider the following example:

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

The stdcall directive is required to ensure that the right-to-left calling convention is used, and to specify that the routine is responsible for cleaning up the stack and not the program. The Fortran DLL expects this calling convention. The function or procedure can then be called as a normal routine, e.g.

        WriteLn(S18AEF(X, IFAIL));

Multi-Dimensional Array

Arrays of more than one dimension have to be transposed before they can be passed to the Fortran DLL. This is because Fortran assumes that an array such as A[2,2] is stored in contiguous locations in column order i.e. as A[1,1], A[2,1], A[1,2], A[2,2]. Pascal, on the other hand, stores the elements in row order as A[1,1], A[1,2], A[2,1], A[2,2]. Note that the Pascal arrays handed as actual parameters to a Fortran DLL must be defined as data types as in the example. A Pascal variable array defined in the var section, passed as an actual argument, overwrites other parameter values and can cause system failure. See example of function/procedure passing for illustration of multi-dimensional array handling.

Passing Functions and Procedures

Many of the NAG Libraries require subroutines and functions to be passed as parameters. To achieve this in Delphi each procedure or function to be passed needs its own data type, defined under the type heading. This allows it to be passed to the DLL through the parameter list. The type definition needs to have the same number and type of parameters as the subroutine itself. Note that var is not required since only a copy of the procedure needs to be made during the passing. Note that stdcall is required both on the definition of the function/procedure and on the definition of the datatype to ensure the correct calling convention is used, as before.

D03PCF Example Program Code in Delphi

This code uses the routine D03PCF, which integrates a system of linear or nonlinear parabolic partial differential equations (PDEs). This is found in the NAG DLL NAGD03.DLL. This program illustrates the use of multi-dimensional arrays and function/procedure passing as described above. Note that it also uses the external function X01AAF, found in NAGSX.DLL, to find pi.

 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. These need to be defined so that the procedures BNDARY and PDEDEF can be passed as parameters (of type procedure) to the 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.

String Handling and Passing

Several Fortran DLLs require strings or characters to be passed as parameters. The strings need to be null terminated, and defined either with Pchar, or as an array of characters such as:

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

The example program uses an array of characters for simplicity. Note that the array has to be zero based. The DLL routine will expect a zero based string array and will fail if it does not receive one.

The routines expect the length of the string in characters to be passed after the string itself. The best way to do this is to pass this as an extra integer parameter after each string or character,
e.g.

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

and in calling:

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

The extra parameters can be added with no problems because an integer is expected after each string, character or array of strings, such as Strng_ArrayType.

G02EEF Example Program Code in Delphi

This code uses the routine G02EEF to carry out one step of a forward selection procedure to enable the 'best' linear regression model to be found. This example was chosen to illustrate the problems that arise through passing strings to Fortran DLLs. It also includes another example of multi-dimensional array handling.

  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.

© The Numerical Algorithms Group 2008
Privacy Policy | Trademarks

© Numerical Algorithms Group

Visit NAG on the web at:

www.nag.co.uk (Europe and ROW)
www.nag.com (North America)
www.nag-j.co.jp (Japan)

http://www.nag.co.uk/numeric/borlanddelphi.asp