Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
Announcements
Welcome to the Intel Community. If you get an answer you like, please mark it as an Accepted Solution to help others. Thank you!
26748 Discussions

Transfer a VB variant array in DLL call from Fortran

Dominguez__Fernando
176 Views

Hi,

I need to call (from Fortran) a DLL that returns a Visual Basic VARIANT array with 100 elements: 97 of them are doubles and 3 are character strings.

In VB the function call is as follows:

Declare Function CalculateCoil Lib “calcoil.dll” (ByRef inputs as Double, ByRef outputs as Variant, ByRef options as Double) As Boolean
Dim InputData(100) As Double
Dim OutputData(100) As Variant
Dim Options(1) As Variant
InputData(0) = 1,543
… rest of inputs
flag = CalculateCoil(InputData(0), OutputData(0), Options(0))
… all elements of OutputData are doubles except three of them which are strings

Is it possible to call this function from Fortran? How could I pass the Variant array to Fortran?

Please note I have no access to the source code of the DLL

Thank you for any help

Regards

0 Kudos
2 Replies
LeonardB
New Contributor I
176 Views

Hi Fernando

With help from the debugger, I've tried to decode what's transfered when a vector of variants is in the call.

With 32 bit EXCEL vba and fortran code below, I've split up the variant into real, integers and character string :

Declare Sub FORSUB Lib "C:\Users\SETULBMA\Documents\Snuttar\Dll6\Dll6\Debug\Dll6" (A As Variant)

Sub xxx()

Dim A(0 To 2) As Variant
Dim i As Long

i = 123456789
A(0) = 3.14    'real(8)
A(1) = "This is a text string."
A(2) = i       'integer(4)

Call FORSUB(A(0))
End Sub
subroutine forsub(Avariant)
    !DEC$ ATTRIBUTES DLLEXPORT,STDCALL,REFERENCE,ALIAS:"FORSUB" :: FORSUB
    !dir$ attributes reference :: Avariant
    
    use ifnls
    implicit none
    
    integer:: Avariant(4,0:2)
    integer::vartype
    real(8):: valR8
    pointer(locValR8,valR8)
    integer,parameter:: mch=2000
    integer(2):: UCstring(mch)

    pointer(locUCstring,UCstring)
    integer:: j,nch,iret
    integer::i
    
    type variant
        integer::vartype
        real(8)::r8
        integer(4)::i4
        character(len=:),allocatable::string
    end type
    type(variant)::A(0:2)
    
    do i=0,2
        vartype=Avariant(1,i)
        A(i).vartype=vartype
        select case(vartype)
        case(5)  ! real*8
            locValR8=loc(Avariant(3,i))
            A(i).r8=valR8
        case(3)  ! integer*4
            A(i).i4=Avariant(3,i)
        case(8)  ! character
            locUCstring=Avariant(3,i)
            nch=1
            do while(nch.lt.mch .and. UCstring(nch).ne.0) !find string length
                nch=nch+1
            enddo
            allocate(character(len=nch)::A(i).string)
            iret=MBConvertUnicodeToMB(UCstring(1:nch),A(i).string)
        end select
    enddo
    continue
end subroutine

 

 

Dominguez__Fernando
176 Views

Thank you LeonardB!

Reply