MGGM
Joined: 20 Aug 2012 Posts: 5
|
Posted: Tue Aug 21, 2012 3:45 pm Post subject: Excel VBA: Bad DLL calling convention |
|
|
Hi again!
The second problem I'm encountering with a different attempt at using a FORTAN subroutine from Excel-VBA is the error "Bad DLL calling convention"
This is the FORTRAN code (statistical algorithm AS62, it computes Mann-Whitney U distribution):
SUBROUTINE UDIST(M, N, FRQNCY, LFR, WORK, LWRK, IFAULT)
!dec$ attributes dllexport, stdcall, alias:'UDIST', :: UDIST
REAL FRQNCY(LFR), WORK(LWRK)
INTEGER MINMN, MN1, MAXMN, N1, I, IN, L, K, J
REAL ZERO, ONE, SUM
DATA ZERO /0.0/, ONE /1.0/
IFAULT = 1
MINMN = MIN(M, N)
IF (MINMN .LT. 1) RETURN
IFAULT = 2
MN1 = M * N + 1
IF (LFR .LT. MN1) RETURN
MAXMN = MAX(M, N)
N1 = MAXMN + 1
DO 1 I = 1, N1
1 FRQNCY(I) = ONE
IF (MINMN .EQ. 1) GO TO 4
IFAULT = 3
IF (LWRK .LT. (MN1 + 1) / 2 + MINMN) RETURN
N1 = N1 + 1
DO 2 I = N1, MN1
2 FRQNCY(I) = ZERO
WORK(1) = ZERO
IN = MAXMN
DO 3 I = 2, MINMN
WORK(I) = ZERO
IN = IN + MAXMN
N1 = IN + 2
L = 1 + IN / 2
K = I
DO 3 J = 1, L
K = K + 1
N1 = N1 - 1
SUM = FRQNCY(J) + WORK(J)
FRQNCY(J) = SUM
WORK(K) = SUM - FRQNCY(N1)
FRQNCY(N1) = SUM
3 CONTINUE
4 IFAULT = 0
SUM = ZERO
DO 10 I = 1, MN1
SUM = SUM + FRQNCY(I)
FRQNCY(I) = SUM
10 END DO
DO 20 I = 1, MN1
20 FRQNCY(I) = FRQNCY(I) / SUM
RETURN
END
This is the VBA side:
Option Base 1
Option Explicit
Private Declare Sub UDIST Lib "E:\Test\AS62.dll" _
(m As Long, _
n As Long, _
frqncy As Single, _
lfr As Long, _
work As Single, _
lwrk As Long, _
ifault As Long)
Public Function UPROB(m As Long, n As Long, U As Long) As Variant
On Error GoTo errtrap
Dim minmn As Long, frqncy() As Single, lfr As Long, work() As Single, lwrk As Long, ifault As Long
minmn = Application.WorksheetFunction.Min(m, n)
lfr = m * n + 1
lwrk = 2 + Int(minmn + (lfr + 1) / 2)
ReDim work(lwrk)
ReDim frqncy(lfr)
Call UDIST(m, n, frqncy(1), lfr, work(1), lwrk, ifault)
' If ll is OK, get the frecuency for U value - first value is U=0
UPROB = frqncy(U+1)
' Error trap to find out the malfunctioning cause
errtrap:
UPROB = Err.Description
End Function
Any ideas?
Thanks,
Marta GG |
|