VBA and Fortran DLL pointer

[chinhqnguyen]

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.

[Steven_L_Intel1]

How do you declare and call the routine from VBA?

Steve

[chinhqnguyen]

 
 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

[gfthomas8]

> 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.

[Jugoslav_Dujic]

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

[Jugoslav_Dujic]

P.S. I consider the part of VB syntax fixed by Gerry the most aspect of Visual Basic language

[durisinm]

This may be just a typo in your post, but you have cur=>llsetgetp(sets), while below you define type(set).

Mike

[chinhqnguyen]

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

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 -

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