Newton Excel Bach, not (just) an Excel Blog

In this post the procedures described for C++ here will be replicated for Fortran:

The spreadsheet, fortran source code, and compiled dll described in this code may be downloaded from Cubic.zip

As always, it is better to use the downloaded code, rather than copying from the post, because the WordPress software changes quotes (“”) and several other characters, so that code copied and pasted from the post will often not run without editing.

This post describes:

The Fortran code for the quadratic function (QUADA) is shown below:


F_stdcall FUNCTION QUADA(qdat, ResA, NumRows)
IMPLICIT NONE

INTEGER, intent(in) :: NumRows
REAL(2), intent(in) :: qdat(NumRows, 3)
REAL(2), intent(out) :: ResA(NumRows,2)

REAL(2) :: QUADA
REAL(2) :: P, DIS

INTEGER I

DO I=1, NumRows

IF (qdat(I,1).NE.0.D+0) THEN

! quadratic problem
P=5.D-1*qdat(I,2)/qdat(I,1)
DIS=P**2-qdat(I,3)/qdat(I,1)
IF (DIS.GE.0.D+0) THEN
! two real solutions!
ResA(I,1)=-P-SQRT(DIS)
Resa(I,2)=-P+SQRT(DIS)
QUADA=2
ELSE
! no real solution!
QUADA=0
END IF

ELSE IF (qdat(I,2).NE.0.D+0) THEN

! linear equation
ResA(I,1)=-qdat(I,3)/qdat(I,2)
QUADA=1

ELSE
! no equation
QUADA=0
END IF
END DO

RETURN
END FUNCTION QUADA

Note that:

• The function is preceded with “F_stdcall”
• The function parameters: qdat, ResA, and NumRows are declared as either intent(in) or intent(out); intent(inout) is also allowed.
• The arrays qdat and ResA are dynamic, and will be sized at run time to the size specified in NumRows
• Paramaters that are specified as double in VBA are REAL(2) in Fortran
• Parameters specified as Long in VBA are Integers in Fortran
• It is essential to ensure that both the data types and the sizes of arrays in the VBA and Fortran routines match.

The fortran routine is compiled as a dll as before, and may then be called from a VBA routine.  The dll has been named cubic.dll, since it contains both the quadratic and cubic functions:


Declare Function QUADA Lib "D:\Users\...\Cubic\Release\Win32\Cubic.dll" (qdat As Double, ResA As Double, NumRows As Long) As Double

Function FQuada(QuadData As Variant) As Variant
Dim xa() As Double
Dim A As Double, b As Double, c As Double
Dim ResA() As Double, NumRows As Long
Dim Retn As Double, i As Long, j As Long
On Error Resume Next

QuadData = QuadData.Value2
NumRows = UBound(QuadData) – LBound(QuadData) + 1

ReDim xa(1 To NumRows, 1 To 3)
ReDim ResA(1 To NumRows, 1 To 2)
For i = 1 To NumRows
For j = 1 To 3
xa(i, j) = QuadData(i, j)
Next j
Next i
Retn = QUADA(xa(1, 1), ResA(1, 1), NumRows)

FQuada = ResA

End Function

As for C++ dlls, array parameters are passed by reference by entering the first member of the array. Unlike C++, in Fortran the array members are named in the same way as VBA; i.e. ArrayName(Row No, Column No).

A screen shot showing the output of the quadratic function is shown below:

Output from QuadA

Fortran code for two Cubic functions, and the resulting dll, are included in the download files.  The code to call these functions from VBA is shown below:
Declare Function CUBIC Lib “D:\Users\…\Cubic\Release\Win32\Cubic.dll” (cdat As Double, ResA As Double) As Double
Declare Function CUBICA Lib “D:\Users\..,\Cubic\Release\Win32\Cubic.dll” (cdat As Double, ResA As Double, NumRows As Long) As Double

Function FCUBIC(P As Variant) As Variant
Dim P1(1 To 4) As Double, Res(1 To 1, 1 To 3) As Double
Dim cval As Double, i As Long

P = P.Value

For i = 1 To 4
P1(i) = P(1, i)
Next i

cval = CUBIC(P1(1), Res(1, 1))

FCUBIC = Res

End Function

Function FCubica(CubicData As Variant) As Variant
Dim xa(1 To 4) As Double
Dim ResA1() As Double, ResA(1 To 1, 1 To 3) As Double, NumRows As Long
Dim Retn As Double, i As Long, j As Long
On Error Resume Next

CubicData = CubicData.Value2
NumRows = UBound(CubicData) – LBound(CubicData) + 1

ReDim ResA1(1 To NumRows, 1 To 3)
For i = 1 To NumRows
For j = 1 To 4
xa(j) = CubicData(i, j)
Next j
Retn = CUBIC(xa(1), ResA(1, 1))
For j = 1 To 3
ResA1(i, j) = ResA(1, j)
Next j
Next i

FCubica = ResA1

End Function

Function FCubica2(CubicData As Variant) As Variant
Dim xa() As Double
Dim ResA() As Double, NumRows As Long
Dim Retn As Long, i As Long, j As Long
On Error Resume Next

CubicData = CubicData.Value2
NumRows = UBound(CubicData) – LBound(CubicData) + 1
ReDim xa(1 To NumRows, 1 To 4)
ReDim ResA(1 To NumRows, 1 To 3)
For i = 1 To NumRows
For j = 1 To 4
xa(i, j) = CubicData(i, j)
Next j
Next i
Retn = CUBICA(xa(1, 1), ResA(1, 1), NumRows)

FCubica2 = ResA

End Function

The code includes one function that operates on one equation at a time, and two alternative array functions that provide much better performance by avoiding the transfer of data between the spreadsheet and VBA. For comparison VBA cubic functions are also included in the download file.

Screenshot of cubic function output and relative performance results: