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:
Transferring arrays between VBA and Fortran.
Writing and compiling a simple Fortran function to solve quadratic equations, and linking to it from Excel.
Compiling a Fortran function to solve cubic equations, and linking from Excel.
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:
