Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

VBA and Fortran DLL pointer

chinhqnguyen
Beginner
647 Views
I am trying to run a Fortran Dll in a VBA application. The fortran program is running fine on Unix. I used Compaq Visual Fortran compiler and created the Dll successfully. However I faced the following runtime error when the Dll was called from VBA:

?The instruction at ?0x02d6f89d? referenced memory at ?0x00000?. The memory could not be ?written??.

I found out that the problem is from the following line:

cur=>llsetgetp(sets)

where:

type(set), pointer :: cur
------------------------------------------
function llsetgetp(ll) result(point)
type(llset):: ll
type(set), pointer :: point
point=>ll%current%item
end function llsetgetp
----------------------------------------------
type llset
private
type(llsetiterator), pointer :: top,last,current
!total number of nodes in the list
integer(4) :: nnodes
end type llset
--------------------------------------------------
type llsetiterator
private
type(set), pointer :: item
type(llsetiterator), pointer :: next,prev
end type llsetiterator
------------------------------------------------------
type set
integer(4) :: eff1,eff2
type(massprop) :: mp
logical(4) :: flg
end type set
---------------------------------------------------------
type massprop
real(8) :: inert(6),cg(3),wt
end type massprop
-------------------------------------------------------

I will appreciate anybody who can help me.
0 Kudos
7 Replies
Steven_L_Intel1
Employee
647 Views
How do you declare and call the routine from VBA?

Steve
0 Kudos
chinhqnguyen
Beginner
647 Views
 
Hi Steve,

Below please find a copy of my VBA program

===================Declaration======================
Public Declare Sub sumadd Lib "F:UsersPeterVisualFortranSumRecordReleaseSumRecord.dll" ( _
wt As Double, cg As Double, inert As Double, _
eff1 As Long, eff2 As Long, nsets As Long)


Public Declare Sub sumget Lib "F:UsersPeterVisualFortranSumRecordReleaseSumRecord.dll" ( _
NumSets As Long, wt As Double, cg As Double, inert As Double, eff1 As Long, eff2 As Long)


=======================Program itself==================

Private Sub CallFotranDLL_Click()
Dim i, j As Integer
Dim weight As Double
Dim cg(3) As Double
Dim inert(6) As Double
Dim eff1, eff2, nsets As Long

Dim awt() As Double
Dim acg() As Double
Dim ainert() As Double
Dim aeff1() As Long
Dim aeff2() As Long

For i = 2 To 4
weight = Cells(i, 1).Value
cg(1) = Cells(i, 2).Value
cg(2) = Cells(i, 3).Value
cg(3) = Cells(i, 4).Value
inert(1) = Cells(i, 5).Value
inert(2) = Cells(i, 6).Value
inert(3) = Cells(i, 7).Value
inert(4) = Cells(i, 8).Value
inert(5) = Cells(i, 9).Value
inert(6) = Cells(i, 10).Value
eff1 = Cells(i, 11).Value
eff2 = Cells(i, 12).Value

Call sumadd(weight, cg(1), inert(1), eff1, eff2, nsets)

Cells(i, 13).Value = nsets
Cells(i, 13).Font.Bold = True
Next i

ReDim awt(nsets) As Double
ReDim acg(3, nsets) As Double
ReDim ainert(6, nsets) As Double
ReDim aeff1(nsets) As Long
ReDim aeff2(nsets) As Long

Call sumget(nsets, awt(1), acg(1, 1), ainert(1, 1), aeff1(1), aeff2(1))


End ' to unloadd the dll file

End Sub
===================sumadd fortran prgram================
subroutine sumadd (wt, cg, inert, eff1, eff2, nsets)
!DEC$ ATTRIBUTES DLLEXPORT :: sumadd
!DEC$ ATTRIBUTES ALIAS :'sumadd' :: sumadd

real(8), intent(in) :: wt, cg(3), inert(6)
integer(4), intent(in) :: eff1, eff2
integer(4), intent(out) :: nsets

type(set) :: s
type(set), pointer :: cur
integer(4) :: nzero
logical(4) :: found

nsets=0
if(nint(100d0*wt).eq.0)return
if(llsetnnodes(sets).eq.0)then
s%flg=.false.
s%mp%wt=0d0
s%mp%cg=0d0
s%mp%inert=0d0
s%eff1=1
s%eff2=9999
call llsetadd(sets,s)
endif
s%eff1=eff1
s%eff2=eff2
s%mp%cg=cg
s%mp%wt=wt
s%mp%inert=inert
s%flg=.true.
call addset(s)
nzero=0
found=llsetfirst(sets)
do while(found)
cur=>llsetgetp(sets)
if(.not.cur%flg)nzero=nzero+1
found=llsetnext(sets)
enddo
nsets=llsetnnodes(sets)-nzero
end subroutine sumadd

===============sumget fortran program===================
subroutine sumget(numSets, wt, cg, inert, eff1, eff2)
!DEC$ ATTRIBUTES DLLEXPORT :: sumget
!DEC$ ATTRIBUTES ALIAS :'sumget' :: sumget

integer(4), intent(in) :: numSets
real(8), intent(out) :: wt(numSets), cg(3, numSets), inert(6, numSets)
integer(4), intent(out) :: eff1(numSets), eff2(numSets)
integer(4) :: i
logical (4) :: found
type(set), pointer :: cur

integer(4) :: addr
i = 0
found = llsetfirst(sets)
do while (found)
cur=>llsetgetp(sets)
if(cur%flg)then
i = i + 1
wt(i) = cur%mp%wt
cg(:,i) = cur%mp%cg
inert(:,i)= cur%mp%inert
eff1(i) = cur%eff1
eff2(i) = cur%eff2
endif
found = llsetdelete(sets)
enddo


end subroutine sumget







0 Kudos
gfthomas8
Novice
647 Views
> Private Sub CallFotranDLL_Click()
> Dim i, j As Integer
> Dim weight As Double
> Dim cg(3) As Double
> Dim inert(6) As Double
> Dim eff1, eff2, nsets As Long
>
Change
Dim i, j As Integer to Dim i As Integer, j As Integer
Dim eff1, eff2, nsets As Long to Dim eff1 As Long , eff2 As Long , nsets As Long

otherwise i and eff1,2 are variants. This will help but you might have other problems that didn't hit me on first sight.

HTH,
Gerry T.
0 Kudos
Jugoslav_Dujic
Valued Contributor II
647 Views
Also, VBA arrays are indexed from 0...n-1 unless, if I recall correctly, Option Base 1 is specified. I can spot few more oddities (e.g. where is variable sets) defined?), but they may be due to code snipping. IMPLICIT NONE would certainly, if not eliminate, or at least exclude some possible causes.

include "same_disclaimer_as_Gerry's"

Jugoslav
0 Kudos
Jugoslav_Dujic
Valued Contributor II
647 Views
P.S. I consider the part of VB syntax fixed by Gerry the most aspect of Visual Basic language
0 Kudos
durisinm
Novice
647 Views
This may be just a typo in your post, but you have cur=>llsetgetp(sets), while below you define type(set).

Mike
0 Kudos
chinhqnguyen
Beginner
647 Views
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Thank you all you guys, Steve, Gerry, Jugoslav, Mike.

You guys have tried to help me solve the problem.
Luckily, I have just found out the error in my
Fortran program. I had tried to access the empty
linked list. That's why I got the error message
indicating the problem with the memory reference.
I have fixed it and it runs very good now.

Again thank you everybody

- Peter -

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

0 Kudos
Reply