strange arguments passing problem (from vba to fortran dll)

Dear all,

I encounter a strange problem when I am trying to pass arguments from
VBA (excel 2003) to fortran dll (compiled using CVF 6.6b).

debug in cvf environment shows some of the arguments are passed
correctly while some are not.

I attached part of the code here. The arguments passed correctly are
f_max, ppw, ma, para_H2. For other array arguments, only the first
elements are passed correctly.

any comments or suggestions are appreciated.

fortran side

subroutine simple (control, ma, f_max, ppw, &
acc, profile, degradation, &
tabk, para_H2, node_depth, layer_depth, &
out_a)

!DEC$ATTRIBUTES DLLEXPORT:: simple
!DEC$ATTRIBUTES ALIAS: 'simple':: simple

integer(4) :: i, j, k, m, boundary, nt_out, nlayer, N_spr, lay_max ,
N, lay, &
nt, n_o, n_new, n_ma, ndt, N_obs

integer(4) :: n_sublay(100), node_index(100), layer_index(100), &
material (2000)

integer(4) :: control(7), ma(100)

real(8) :: f_max, ppw, dtt, vs_r, rho_r, v_in_0, a_in_0, dt, d_t,
duration ,&
v_in_1, a_in_1, eps, ac1, ac2, xi, t_k(8), a_k(8), b_k(8),
tabk(8,3), sum

real(8) :: t(10000), a(10000), acc(10000,2), a_in(100000), tt(100000),
&
h(100), v(100), x(100), r(100), G(100),
profile(100,4), &
strn_G(20,100), G_vec(20,100), strn_x(20,100), x_vec(20,100),
&
sublay(100), dh(100), node_depth(100), layer_depth(100), &
dz(2000), vs(2000), rho(2000), damp(2000), Gmax(2000),
strain_G(20,2000), G_vector(20,2000), &
v_est_1(2000), a_nt(2000), d_1(2000), tau_1(2000),
gamma_0(2000), d_gamma_0(2000), &
v_est_2(2000), v_nt(2000), d_2(2000), tau_0(2000),
gamma_1(2000), d_gamma_1(2000), &
out_a(10000,100), out_v(10000,100), out_d(10000,100),
out_gamma(10000,100), out_tau(10000,100), &
max_a(100), max_v(100), max_d(100), max_gamma(100),
max_tau(100), &
degradation(20,200), ak(500,2000), fy(500,2000),
ss(500,2000), &
x_ini(100), Qfactor(100), chi(100), w_k(8,100),
x_vec_n(20,100), w_k_sub(8,2000), &
memory_0(8,2000), memory_1(8,2000), a_val(100), b_val(100),
a_val_sub(2000), b_val_sub(2000), &
para_H2(10,50), s_val(100), beta(100), s_val_sub(2000),
beta_sub(2000)

!!!!!! main part of program omitted

end

subroutine make_spring_HY (ak, fy, Gmax, a, b, s, beta, N_spr)
integer(4) :: j, N_spr
real(8) :: ak(N_spr), fy (N_spr), G_tan( N_spr), &
& tau (N_spr), gamma(N_spr), Gmax , &
& strain_G(N_spr), G_vector(N_spr), factor, ratio, a, b, s, beta

gamma(1)=10.0**-6.0; factor=10.0**0.05
do i=2, N_spr; gamma(i)=gamma(i-1)*factor; enddo

do j=1,N_spr
call my_HY (ratio, a, b, s, beta, gamma(j))
tau(j)=Gmax*ratio*gamma(j)
enddo

G_tan(1)=tau(1)/gamma(1) ! 1st tangent modulus
do j=2,N_spr
G_tan(j)=(tau(j)-tau(j-1))/(gamma(j)-gamma(j-1))
enddo
do j=1,N_spr-1
ak(j)=G_tan(j)-G_tan(j+1)
fy(j)=ak(j)*gamma(j)
enddo
ak(N_spr)=G_tan(N_spr) ; fy(N_spr)=ak(N_spr)*gamma(N_spr)
end

subroutine my_HY (ratio, a, b, s, beta, gamma)
real(4) ratio, a, b, s, beta, gamma, strain_ref
strain_ref=a+gamma*b; ratio=1/(1+beta*(gamma/strain_ref)**s)
end


subroutine iwan_parallel (stress, si, aki, fyi, N_spr, d_gamma)
integer(4) N_spr
real(8) :: force, si(N_spr), aki(N_spr), fyi(N_spr), d_gamma, stress

force = 0.0
do i=1,N_spr
si(i) = si(i) + aki(i) * d_gamma
if (si(i) > fyi(i)) then
si(i) = fyi(i)
else if (si(i) < -fyi(i) ) then
si(i) = -fyi(i)
endif
force = force + si(i)
enddo
stress = force
end


VBA part

Private Declare Sub simple Lib "hytest.dll" (ByRef control As Long,
ByRef ma As Long, ByRef f_max As Double, ByRef ppw As Double, _
ByRef acc As Double, ByRef profile As Double, ByRef
degradation As Double, _
ByRef tabk As Double, ByRef para_H2 As Double, ByRef
node_depth As Double, ByRef layer_depth As Double, _
ByRef out_a As Double)
Option Explicit
Option Base 1
Sub wave()


Dim f_max, ppw As Double

Dim i, j, nt_out, nlayer, n_ma As Long

Static control(7), ma(100) As Long

Dim acc(10000, 2), profile(100, 4), _
degradation(20, 200), tabk(8, 3), para_H2(10, 50) As Double

Dim node_depth(100), layer_depth(100) As Double

Dim out_a(10000, 100)

For i = 1 To 100
node_depth(i) = 0#
layer_depth(i) = 0#

For j = 1 To 10000

out_a(j, i) = 0#


Next j
Next i

f_max = CDbl(Worksheets("control").Cells(1, 1).Value)
ppw = CDbl(Worksheets("control").Cells(1, 2).Value)

control(1) = CLng(Worksheets("control").Cells(1, 3).Value)
control(2) = CLng(Worksheets("control").Cells(1, 4).Value)
control(3) = CLng(Worksheets("control").Cells(1, 5).Value)
control(4) = CLng(Worksheets("control").Cells(1, 6).Value)
control(5) = CLng(Worksheets("control").Cells(1, 7).Value)
control(6) = CLng(Worksheets("control").Cells(1, 8).Value)
control(7) = CLng(Worksheets("control").Cells(1, 9).Value)

nlayer = control(3)
nt_out = control(4)
n_ma = control(5)

For i = 1 To nt_out
acc(i, 1) = CDbl(Worksheets("incident").Cells(i, 1).Value)
acc(i, 2) = CDbl(Worksheets("incident").Cells(i, 2).Value)
Next i


For i = 1 To nlayer + 1
profile(i, 1) = CDbl(Worksheets("profile").Cells(i, 1).Value)
profile(i, 2) = CDbl(Worksheets("profile").Cells(i, 2).Value)
profile(i, 3) = CDbl(Worksheets("profile").Cells(i, 3).Value)
profile(i, 4) = CDbl(Worksheets("profile").Cells(i, 4).Value)
ma(i) = CLng(Worksheets("profile").Cells(i, 5).Value)
Next i



For i = 1 To 20
For j = 1 To 4 * n_ma
degradation(i, j) = CDbl(Worksheets("curve").Cells(i, j).Value)
Next j
Next i



For i = 1 To 8
tabk(i, 1) = CDbl(Worksheets("tabk").Cells(i, 1).Value)
tabk(i, 2) = CDbl(Worksheets("tabk").Cells(i, 2).Value)
tabk(i, 3) = CDbl(Worksheets("tabk").Cells(i, 3).Value)
Next i





For i = 1 To 10
For j = 1 To 50
para_H2(i, j) = CDbl(Worksheets("h2_n").Cells(i, j).Value)
Next j
Next i


Call simple(control(1), ma(1), f_max, ppw, _
acc(1, 1), profile(1, 1), degradation(1, 1), _
tabk(1, 1), para_H2(1, 1), node_depth(1),
layer_depth(1), _
out_a(1, 1))

For i = 1 To nt_out
For j = 1 To nlayer + 1

Worksheets("out").Cells(i, j).Value = out_a(i, j)
Next j
Next i



End Sub

.

Quantcast