Visual Fortran dll, mixed language, Visual Basic

Visual Fortran dll, mixed language, Visual Basic

Dear developers,

I have to solve the following problem. I want to use the IMSL DBCLSF (FCN, M, N, XGUESS, IBTYPE, XLB, XUB, XSCALE, FSCALE, IPARAM, RPARAM, X, FVEC, FJAC, LDFJAC) library routine to perform least square fit on my data. The fit function have to be defined in the following form:
FCN(M,N,X,F), where M and N are dimensions of the X and F vectors. X vector is the fitting variable and F vector is the difference of the fitting function and my data value.

I intend to call DBCLSF from a Visual Basic program via an interface function. The puzzle is that how can I pass my data vector Y to the FCN(M,N,X,F) function, when I can not put Y in to the argumentum list?

I thought that I can make an entry point inside FCN let say entry FCNDATA(Y) and call it inside the dll, but it did not work.

There can be another soultion using common /mydata/ Y in both of the dll calling subroutine and FCN function, but I had also problems with this solution.

Is there anybody who can help to resolve this puzzle?

Let me provide the code for the first solution of mine:

subroutine mylsf(regleft, regright, spin, N, XGUESS, IBTYPE, XLB, XUB, XSCALE, &
FSCALE, IPARAM, RPARAM, X, FVEC, FJAC, LDFJAC)
!DEC$ ATTRIBUTES DLLEXPORT :: mylsf
use imsl
external FCN
external FCNINIT
integer(4), intent(in) :: regleft
integer(4), intent(in) :: regright
real(8), intent(in) :: spin(65536)
integer(4), intent(in) :: N
real(8), intent(inout) :: XGUESS(*)
integer(4), intent(inout) :: IBTYPE
real(8), intent(inout) :: XLB(*)
real(8), intent(inout) :: XUB(*)
real(8), intent(in) :: XSCALE(*)
real(8), intent(in) :: FSCALE(*)
integer(4), intent(inout) :: IPARAM(6)
real(8), intent(inout) :: RPARAM(7)
real(8), intent(out) :: X(*)
real(8), intent(out) :: FVEC(*)
real(8), intent(out) :: FJAC(:,:)
integer(4), intent(in) :: LDFJAC
integer(4) M
!For the second solution common /mydata/ spin and delete
the CALL FCNINIT ... line
CALL FCNINIT(spin,regleft,regright)
M=regleft-regright+1
stop
CALL DBCLSF (FCN, M, N, XGUESS, IBTYPE, XLB, XUB, XSCALE, &
FSCALE, IPARAM, RPARAM, X, FVEC, FJAC, LDFJAC)
return
end
!*******************************************
subroutine FCN(M,N,X,F)
!DEC$ ATTRIBUTES DLLEXPORT :: FCNINIT
USE linear_operators
real(8) sp( 65536)
integer(4) rl
integer(4) rr
integer(4) M,N
real(8) X(:),F(:),xi
!Here I could imagine a common /mydata/ sp to solve it
!with no entry part as the second solution
do i=1,M
xi=i
F(i)=(sp(rl-1+i)-peak_shape(xi,x,N))**2/(sp(rl-1+i)+1.0d0)
enddo

return
entry FCNINIT(sp,regleft,regright)
! set left and right region boundary
rl=regleft;rr=regright
return
end

The calling Visual Basic program is:

Private Declare Sub MYLSF Lib "h:MyProjectslsqDebuglsq" (ByRef regleft As Long, ByRef regright As Long, ByRef spin() As Double, n As Long, _
ByRef XGUESS() As Double, ByRef IBTYPE As Long, ByRef XLB() As Double, ByRef XUB() As Double, _
ByRef XSCALE() As Double, ByRef FSCALE() As Double, ByRef IPARAM() As Long, ByRef RPARAM() As Long, _
ByRef x() As Double, ByRef FVEC() As Double, ByRef FJAC() As Double, ByRef LDFJAC As Long)

Dim spin(1 To 65536) As Double, xg(1 To 100) As Double, IBTYPE As Long, _
XLB(1 To 100) As Double, XUB(1 To 100) As Double, _
XSCALE(1 To 100) As Double, FSCA
LE(1 To 1000) As Double, IPARAM(1 To 6) As Long, _
RPARAM(1 To 7) As Long, x(1 To 100) As Double, FVEC(1 To 1000) As Double, _
FJAC(1 To 1000, 1 To 100) As Double, LDFJAC As Long

Sub fit()
regleft = 1: regright = 81: n = 6
For i = 1 To 81
spin(i) = Sheet1.Cells(i, 5)
FSCALE(i) = 1#
Next i
xg(1) = 0.5: xg(2) = 1#: xg(3) = 0#: xg(4) = 41#: xg(5) = -0.5: xg(6) = 7#
IBTYPE = 1: LDFJAC = 1000
For i = 1 To 6
XSCALE(i) = 1#
Next i
Call MYLSF(regleft, regright, spin, n, xg, IBTYPE, XLB, XUB, XSCALE, _
FSCALE, IPARAM, RPARAM, x, FVEC, FJAC, LDFJAC)
For i = 1 To 6
Sheet1.Cells(i, 6) = x(i)
Next i

End Sub

1 post / 0 new
For more complete information about compiler optimizations, see our Optimization Notice.