k_order_simul+local_state_space_iteration_fortran MEX: fix gfortran warnings
parent
1eee9c53b7
commit
e722e908e5
|
@ -45,9 +45,9 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
type(pol), dimension(:), allocatable, target :: fdr, udr
|
type(pol), dimension(:), allocatable, target :: fdr, udr
|
||||||
integer :: order, nstatic, npred, nboth, nfwrd, exo_nbr, endo_nbr, nys, nvar, nper
|
integer :: order, nstatic, npred, nboth, nfwrd, exo_nbr, endo_nbr, nys, nvar, nper
|
||||||
real(real64), dimension(:,:), allocatable :: shocks, sim
|
real(real64), dimension(:,:), allocatable :: shocks, sim
|
||||||
real(real64), dimension(:), allocatable :: ysteady, ystart, ysteady_pred, ystart_pred, dyu
|
real(real64), dimension(:), allocatable :: ysteady_pred, ystart_pred, dyu
|
||||||
|
real(real64), dimension(:), pointer, contiguous :: ysteady, ystart
|
||||||
type(pascal_triangle) :: p
|
type(pascal_triangle) :: p
|
||||||
type(uf_matching), dimension(:), allocatable :: matching
|
|
||||||
type(horner), dimension(:), allocatable :: h
|
type(horner), dimension(:), allocatable :: h
|
||||||
integer :: i, t, d, m, n
|
integer :: i, t, d, m, n
|
||||||
character(kind=c_char, len=10) :: fieldname
|
character(kind=c_char, len=10) :: fieldname
|
||||||
|
@ -112,8 +112,7 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
if (endo_nbr /= int(mxGetM(ystart_mx))) then
|
if (endo_nbr /= int(mxGetM(ystart_mx))) then
|
||||||
call mexErrMsgTxt("ystart should have nstat+npred+nboth+nforw rows")
|
call mexErrMsgTxt("ystart should have nstat+npred+nboth+nforw rows")
|
||||||
end if
|
end if
|
||||||
allocate(ystart(endo_nbr))
|
ystart => mxGetPr(ystart_mx)
|
||||||
ystart = mxGetPr(ystart_mx)
|
|
||||||
|
|
||||||
if (exo_nbr /= int(mxGetM(shocks_mx))) then
|
if (exo_nbr /= int(mxGetM(shocks_mx))) then
|
||||||
call mexErrMsgTxt("shocks should have nexog rows")
|
call mexErrMsgTxt("shocks should have nexog rows")
|
||||||
|
@ -125,8 +124,7 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
if (.not. (int(mxGetM(ysteady_mx)) == endo_nbr)) then
|
if (.not. (int(mxGetM(ysteady_mx)) == endo_nbr)) then
|
||||||
call mexErrMsgTxt("ysteady should have nstat+npred+nboth+nforw rows")
|
call mexErrMsgTxt("ysteady should have nstat+npred+nboth+nforw rows")
|
||||||
end if
|
end if
|
||||||
allocate(ysteady(endo_nbr))
|
ysteady => mxGetPr(ysteady_mx)
|
||||||
ysteady = mxGetPr(ysteady_mx)
|
|
||||||
|
|
||||||
allocate(h(0:order), fdr(0:order), udr(0:order))
|
allocate(h(0:order), fdr(0:order), udr(0:order))
|
||||||
do i = 0, order
|
do i = 0, order
|
||||||
|
@ -146,13 +144,15 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
if (order > 1) then
|
if (order > 1) then
|
||||||
! Compute the useful binomial coefficients from Pascal's triangle
|
! Compute the useful binomial coefficients from Pascal's triangle
|
||||||
p = pascal_triangle(nvar+order-1)
|
p = pascal_triangle(nvar+order-1)
|
||||||
allocate(matching(2:order))
|
block
|
||||||
|
type(uf_matching), dimension(2:order) :: matching
|
||||||
! Pinpointing the corresponding offsets between folded and unfolded tensors
|
! Pinpointing the corresponding offsets between folded and unfolded tensors
|
||||||
do d=2,order
|
do d=2,order
|
||||||
allocate(matching(d)%folded(nvar**d))
|
allocate(matching(d)%folded(nvar**d))
|
||||||
call fill_folded_indices(matching(d)%folded, nvar, d, p)
|
call fill_folded_indices(matching(d)%folded, nvar, d, p)
|
||||||
udr(d)%g = fdr(d)%g(:,matching(d)%folded)
|
udr(d)%g = fdr(d)%g(:,matching(d)%folded)
|
||||||
end do
|
end do
|
||||||
|
end block
|
||||||
end if
|
end if
|
||||||
|
|
||||||
allocate(dyu(nvar), ystart_pred(nys), ysteady_pred(nys), sim(endo_nbr,nper))
|
allocate(dyu(nvar), ystart_pred(nys), ysteady_pred(nys), sim(endo_nbr,nper))
|
||||||
|
|
|
@ -40,7 +40,8 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
type(c_ptr) :: M_mx, options_mx, dr_mx, yhat_mx, epsilon_mx, udr_mx, tmp
|
type(c_ptr) :: M_mx, options_mx, dr_mx, yhat_mx, epsilon_mx, udr_mx, tmp
|
||||||
type(pol), dimension(:), allocatable, target :: udr
|
type(pol), dimension(:), allocatable, target :: udr
|
||||||
integer :: order, nstatic, npred, nboth, nfwrd, exo_nbr, endo_nbr, nparticles, nys, nvar, nrestricted
|
integer :: order, nstatic, npred, nboth, nfwrd, exo_nbr, endo_nbr, nparticles, nys, nvar, nrestricted
|
||||||
real(real64), dimension(:), allocatable :: order_var, ys, ys_reordered, restrict_var_list, dyu
|
real(real64), dimension(:), allocatable :: ys_reordered, dyu
|
||||||
|
real(real64), dimension(:), pointer, contiguous :: order_var, ys, restrict_var_list
|
||||||
real(real64), dimension(:,:), allocatable :: yhat, e, ynext, ynext_all
|
real(real64), dimension(:,:), allocatable :: yhat, e, ynext, ynext_all
|
||||||
type(horner), dimension(:), allocatable :: h
|
type(horner), dimension(:), allocatable :: h
|
||||||
integer :: i, j, m, n
|
integer :: i, j, m, n
|
||||||
|
@ -90,17 +91,16 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
if (.not. (mxIsDouble(order_var_mx) .and. int(mxGetNumberOfElements(order_var_mx)) == endo_nbr)) then
|
if (.not. (mxIsDouble(order_var_mx) .and. int(mxGetNumberOfElements(order_var_mx)) == endo_nbr)) then
|
||||||
call mexErrMsgTxt("Field dr.order_var should be a double precision vector with endo_nbr elements")
|
call mexErrMsgTxt("Field dr.order_var should be a double precision vector with endo_nbr elements")
|
||||||
end if
|
end if
|
||||||
allocate(order_var(endo_nbr))
|
order_var => mxGetPr(order_var_mx)
|
||||||
order_var = mxGetPr(order_var_mx)
|
|
||||||
end associate
|
end associate
|
||||||
|
|
||||||
associate (ys_mx => mxGetField(dr_mx, 1_mwIndex, "ys"))
|
associate (ys_mx => mxGetField(dr_mx, 1_mwIndex, "ys"))
|
||||||
if (.not. (mxIsDouble(ys_mx) .and. int(mxGetNumberOfElements(ys_mx)) == endo_nbr)) then
|
if (.not. (mxIsDouble(ys_mx) .and. int(mxGetNumberOfElements(ys_mx)) == endo_nbr)) then
|
||||||
call mexErrMsgTxt("Field dr.ys should be a double precision vector with endo_nbr elements")
|
call mexErrMsgTxt("Field dr.ys should be a double precision vector with endo_nbr elements")
|
||||||
end if
|
end if
|
||||||
allocate(ys(endo_nbr), ys_reordered(endo_nbr))
|
ys => mxGetPr(ys_mx)
|
||||||
ys = mxGetPr(ys_mx)
|
|
||||||
! Construct the reordered steady state
|
! Construct the reordered steady state
|
||||||
|
allocate(ys_reordered(endo_nbr))
|
||||||
do i=1, endo_nbr
|
do i=1, endo_nbr
|
||||||
ys_reordered(i) = ys(int(order_var(i)))
|
ys_reordered(i) = ys(int(order_var(i)))
|
||||||
end do
|
end do
|
||||||
|
@ -111,8 +111,7 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
call mexErrMsgTxt("Field dr.restrict_var_list should be a double precision vector")
|
call mexErrMsgTxt("Field dr.restrict_var_list should be a double precision vector")
|
||||||
end if
|
end if
|
||||||
nrestricted = size(mxGetPr(restrict_var_list_mx))
|
nrestricted = size(mxGetPr(restrict_var_list_mx))
|
||||||
allocate(restrict_var_list(nrestricted))
|
restrict_var_list => mxGetPr(restrict_var_list_mx)
|
||||||
restrict_var_list = mxGetPr(restrict_var_list_mx)
|
|
||||||
end associate
|
end associate
|
||||||
|
|
||||||
nparticles = int(mxGetN(yhat_mx));
|
nparticles = int(mxGetN(yhat_mx));
|
||||||
|
|
Loading…
Reference in New Issue