使用包含动态数组的结构从 VBA 调用 Fortran 95 dll

Question

我在 Excel VBA 中有一个类型结构，其中包含一个动态数组。我想使用用 Compaq Visual Fortran 编译的FORTRAN .dll 填充值（我知道它很旧，但我受限于 CVF 和 Excel2003）。

Public Type T_STRUCT_3
    COUNT As Long
    VALUE As Double
    ARR() As Double
End Type

Public Declare Sub TestCalc3 Lib "FortranLib.dll" ( _ 
                     ByVal X As Double, ByVal n As Long, ByRef a As T_STRUCT_3)
Public Sub Initialize()
    Dim a As T_STRUCT_3, n As Long
    n = 3
    ReDim a.ARR(1 To n)
    Call TestCalc3(X, n, a)
End Sub

我在 Fortran 中尝试过（但失败了）正在使用以下内容：

module CALCTEST
    IMPLICIT NONE

    INTEGER, PARAMETER :: C_INT = selected_int_kind(9)
    INTEGER, PARAMETER :: C_REAL = selected_real_kind(6, 37)
    INTEGER, PARAMETER :: C_DOUBLE = selected_real_kind(15, 307)

    INTEGER, PARAMETER :: MAX_SIZE = 10
!-----------------------------------------------------------------------    
    type T_STRUCT_3
    SEQUENCE
        INTEGER(C_INT) :: COUNT
        REAL(C_DOUBLE) :: VALUE
        REAL(C_DOUBLE), POINTER :: ARR(:)
    end type T_STRUCT_3

contains
!--------------------------------------------------------------------
    subroutine TestCalc3(X,N,A) 
    !DEC$ATTRIBUTES ALIAS:'TestCalc3' :: TestCalc3
    !DEC$ATTRIBUTES DLLEXPORT :: TestCalc3
    !DEC$ATTRIBUTES VALUE :: N, X

    INTEGER(C_INT), INTENT(IN)      :: N
    TYPE(T_STRUCT_3), INTENT(OUT)   :: A
    REAL(C_DOUBLE), INTENT(IN)      :: X

        A%COUNT = N                 ! Value N is fine and I can assign it to A%COUNT
        A%VALUE = X                 ! Value X is fine and I can assign it to A%VALUE
        A%ARR =(/ (X*I, I=1,N) /)   ! <== how do I point A%ARR to the dynamic array?
                                    ! Here is where the error occurs

    RETURN
    end subroutine

end module

我的编译设置是默认的

PS。使用固定长度的数组我没有问题。我已经填充了这些值并将它们很好地返回到 VBA。

PS2。我没有使用ISO_C_BINDINGS（在 CVF 中不可用）

Answer 1

问题在于，用于 CVF 中结构内部数组的 Fortran 指针的描述符与 VBA 中用于等效组件的描述符不同。

您将需要使用所谓的 Cray 或整数指针和安全数组“滚动您自己的”指针（我认为这是 VBA 用于其一侧的组件 - 即 Fortran 一侧的第三个组件应该是一个持有 VBA 安全数组句柄的 INTEGER）。我不确定 CVF 为后者提供了哪些开箱即用的支持。

最好在 Intel forums 作为 CVF 的继任者提出此类问题。该论坛上可能已经存在如何执行此操作的示例。

Answer 2

如果您真正想做的只是按照您的示例进行操作，那么为什么还要为 Fortran 端的结构烦恼呢？所示示例实际上是一个“固定长度数组”问题，因为您将“n”显式传递给 Fortran s/r，因此 Fortan 将其视为固定长度（参见可分配等）。

也就是说，只需调用 Fortran s/r 要求返回“正常”数组，然后在返回后将数组分配给 VBA 结构，或直接通过 Arg（例如，取决于您是否使用策略 1）或 2 ) 下面)。

在 VBA 和 Fortran 之间传递数组时，您有一些选择，例如：

1) 传递“普通”数组，如：

显然，您的示例中 Fortran 方面所需的所有信息都在 arg 列表中明确提供，所以为什么不直接

Subroutine ForSub(X,n,Arr)
!
Real(XX), Intent(In)    :: X
Integer, Intent(In)     :: n
Real(XX), Intent(Out)   ;; Arr(n)
!
Arr(1:n) = ....
!
End Subroutine ForSub

VBA 端将需要对 Sub 进行适当的声明，然后还需要一个 VBA sub，它具有“直接数组”语法，类似于

Dim Arr(1 to n)
Call ForSub(X, n, Arr(1))

...等

同样在 VBA 方面，使用这种方法，您需要将 Fortran 创建的数组显式分配给 VBA 结构的每个元素。

...这是一种蛮力方法，虽然执行效率不高，但它简单可靠（尽管对于更复杂的设置在 VBA 方面有点痛苦）。

2) 将（仅数组）作为 Variant/SafeArray 传递

或者，您可以作为 Variant/Array 或 Structure 传递值。但是，正如 IanH 建议的那样，这需要将 Args 作为指向 Variant 或 SafeArray 的指针（可以使用其中任何一种，尽管细节有所不同......我使用 Variants 和 Cray 指针方法来传递数组，具体取决于手）。完整的解释相当乏味，但 Fortran 方面可能（取决于所采用的确切方法）看起来像（为简单起见，假设传递数组而不是结构），在这个例子中，Variant 被传入：

!
!************************************************************************
!   Basic stats: returns a vector of stats associated with a series X
!************************************************************************
!
!DEC$ ATTRIBUTES DLLEXPORT :: BASICSTATS1D_XL
!
    Subroutine BASICSTATS1D_XL(X_VARIANTARRAY, N, RESULTS, IERR, &
                                ISTATOPTIONX, &
                                lSTATOPTIONCUMX, &
                                UPPERQUANTILEX, &
                                LOWERQUANTILEX, &
                                LALLOWNONNUMERICX_K2
!
!
    ! This s/r is provided so that long length data sets can be processed, as opposed to XL 29 limit
    ! ==> BUT ALSO, to permit stats for seriest that includ #NA's etc, i.e. return stats for
    !     just the legitimate numeric values in the data set ... if so desired.
    !
    Use ARTType
    Use ARTStats, Only: BasicStats
    !
    Use ARTF90ExcelMixedLangMod, Only: ARTExcelVarArray1D
    !
    ! Necessary to define interface to SafeArrayxxx calls
    !
    Use IFCom !Use dfcom in your case
    !
    Implicit None
    !
    !
    Type(Variant), Intent(In)                   :: x_VariantArray  ! this is an "in" example, but same declaration for "out" also
!
:
:
    !
    Call ARTExcelVarArray1D(VarArray_Ptr = x_VariantArray%VU%Ptr_Val, n = n, FArray = x(:), iErr = iErr, &
                            nAllowNonNumericX = nZZ)
    !

这里 arg x_VariantArray 被声明为 CVF/IVF Variant，可以直接访问 VBA Variant。或者，可以只发送指针（即作为 Cray 指针/整数）并以这种方式访问​​数据，但细节略有不同。

请注意，（自定义）s/r ARTExcelVarArray1D() 用于将 Variant 中的数组转换为 Fortran 数组。对称 s/r 将 Fortran 数组转换为 Intent(Out) 等的变体。一个极其精简的版本（我已经删除了大部分的预处理和后处理以及大量的“VT 测试/强制”等）这样一个 s/r 是（这个是 Integer(4) 的）：

    Subroutine ARTExcelVarArray1D_Int(VarArray_Ptr, n, FArray, iErr, iCoerceX, iFailedCoerceX, iFailedCoerceValX)
    !
    Use IFCom, Only: SafeArrayGetDim, SafeArrayGetLBound, SafeArrayGetUBound, SafeArrayAccessData, SafeArrayUnAccessData
    Use IFWinTY, Only: Variant              ! Variant appears to be in IFCom also, so could STREAMLINE
    !
    Integer, Intent(In)             :: n
    !
    ! Declare array_ptr to be a pointer to an integer.  When Cray pointers
    !  are declared, they must point to something; this DUMMY integer is
    !  simply a placeholder so we can declare the pointer.
    !
    !
    !
    Integer                         :: dummy
    !
    Pointer (VarArray_Ptr, dummy)   ! Can't have Intent() with Ptr's , but this is an (In)
    !
    Integer, Intent(In), Optional   :: iCoerceX, iFailedCoerceX, iFailedCoerceValX
    !
    Integer, Intent(Out)            :: iErr
    !
    Integer, Intent(InOut)          :: FArray(n)
    !
    !
    !
    ! Locals
    ! ------
    !
    ! Declare another pointer, which will be used as the head of the
    !  array of EmployeeInfo's.
    !
    Pointer (Data_ptr, ArrayData)   ! Can't have Intent() with Ptr's, but this Local
    !
    Type(Variant)                   :: ArrayData(n)
    !
    Integer                         :: i, j, k   ! Loop variables
    Integer                         :: iStart, iEnd, nDim
    !
    Integer                         :: Status
    !
    !
    iErr = 0
    !
    FArray(:) = 0
    !
    !
    ! Get SafeArray Shape/Extent etc
    ! ------------------------------
    !
    !
    nDim = SafeArrayGetDim(VarArray_Ptr)
    !
    !
    !
    Status = SafeArrayGetLBound(VarArray_Ptr, 1, iStart)
    Status = SafeArrayGetUBound(VarArray_Ptr, 1, iEnd)
    !
    !
    ! Use the SafeArray routine to get the address of the array of Data
    ! -----------------------------------------------------------------
    !
    Status = SafeArrayAccessData( VarArray_Ptr, Data_ptr )
    !
    If( Status /= 0 ) Then
        !
        !
        iErr = -Status
        Go To 99999
    End If
    !
    !   Return value            Meaning
    !   -------------------------------
    !   S_OK                    Success.
    !   E_INVALIDARG            The argument psa was not a valid safe array descriptor.
    !   E_UNEXPECTED
    !
    ! ... skip lots of things, for this simple illustration
    !
    !
    Call ARTExcelVarArray1D_Int_XX(ArrayData, n, FArray, iErr, iCoerceX, iFailedCoerceX, iFailedCoerceValX)
    !
    !
    !
99999   Continue
    !
    !
    ! When you are done, you must 'deaccess' the data.
    ! ------------------------------------------------
    !
    Status = SafeArrayUnaccessData(VarArray_Ptr)
    !
    If( Status /= 0 ) Then
        !
        ! perform your error handling
        !
    End If
    !
    !
    End Subroutine ARTExcelVarArray1D_Int




Pure Subroutine ARTExcelVarArray1D_Int_XX(ArrayData, n, FArray, iErr, iCoerceX, iFailedCoerceX, iFailedCoerceValX)
!
Use IFWinTY, Only: Variant              ! Variant appears to be in IFCom also, so could STREAMLINE
    !
    !
    Integer, Intent(In)             :: n
    !
    !
    !
    Type(Variant), Intent(InOut)        :: ArrayData(:)
    !
    Integer, Intent(In), Optional   :: iCoerceX, iFailedCoerceX, iFailedCoerceValX
    !
    Integer, Intent(Out)            :: iErr
    !
    Integer, Intent(InOut)          :: FArray(n)
    !
    !
    !
    ! Locals
    !
    Integer                         :: i, iFailedCoerceVal
    !
    !
    !
    !   VT_Type Verification etc
    !   ------------------------
    !
        ! Then some elements of the Array are not required type (e.g. Int, Real etc)
        !
        ! Note: requires option for coercion to other Types
        !       - e.g. if Real(SP) (ie. VT_Type = 2)  then maybe OK etc
        !       - if Int, (i.e. VT_Type = 2 or 3), then what ??
        !... skip lot's of things for this simple illustration
        !
        ! First, apply "Error" handling
        !
        !... skip lot's of things for this simple illustration
    ! Now, fill in the fields
    ! -----------------------
    !... skip lot's of things for this simple illustration
    !
    ForAll(i=1:n)
            FArray(i) = ArrayData(i)%VU%Long_Val
    End ForAll
    !
    !
    !
    End Subroutine ARTExcelVarArray1D_Int_XX

在这个特定的示例中，数据作为一个直接的一维数组（通过 Variant）传入。 Variant Type 包括各种信息位，指示它实际包含的内容，并且需要查询这些元素以确定 Variant 的 etc 和 Fortran vars 之间的转换细节。

我编写了自己的 Variant/SafeArray/BString 等“转换器”（工作量很大，并且有很多细节），但是 CVF/IVF 包中有示例，并且在线提供。一般来说，您将需要一组这样的例程来处理 Int/Real/BString 1-D/n-D 等，以及大量的“重载”。

BString/VBString 的情况更加繁琐，尤其是当您的数组是 B/VBString 数组时。

创建基于显式 (Cray) 指针的 var 和/或显式 Variant var 后，使用 Watch 单步执行代码对于了解这些类型的结构及其包含的信息非常有用

您可能还希望查看/获取 Canaima 的 F90VB 包，它可以为您完成所有这些（以及更多）（尽管 CVF/IVF 变体和 Canaima 的 F90VB 变体等之间的内部结构略有不同） )。

VBA 端的语法也略有不同，具体取决于您的 VBA 变量是否声明为 Variant、Range 等

有趣的是，通过这种方法传递数组的执行速度要快得多（主要是因为不需要执行 VBA 端逐个元素的数组分配，以及 VBA 所需的许多其他“奇怪”的事情-side（VBA/COM 对数组不是特别友好），尤其是多暗淡的 arr's、Range 等）。

不利的一面是，编码更多地涉及 Fortran 方面，并且需要大量的预处理和后处理检查才能实现稳健的实现。

3) 对于类型化/结构化变量

使用结构来做到这一点只是一个扩展，但“更多的血腥”。有一个特殊的方式来传递结构在 CVF 包中的一个例子，在 dir ... MsDev\DF98\SAMPLES\MIXLANG\VB\TYPEARRAYS 中，网上有很多讨论。

如果您愿意，您可以在没有任何 ISO 绑定的情况下完成所有这些操作。