Fixing the header doc and automake files for the local state space iteration Fortran MEX
parent
7083f1d692
commit
a576bdd03f
|
@ -1,6 +1,6 @@
|
||||||
mex_PROGRAMS = folded_to_unfolded_dr
|
mex_PROGRAMS = folded_to_unfolded_dr
|
||||||
|
|
||||||
folded_to_unfolded_dr_FCFLAGS = $(AM_FCFLAGS) -Warray-temporaries -I../libkordersim
|
folded_to_unfolded_dr_FCFLAGS = $(AM_FCFLAGS) -I../libkordersim
|
||||||
|
|
||||||
nodist_folded_to_unfolded_dr_SOURCES = \
|
nodist_folded_to_unfolded_dr_SOURCES = \
|
||||||
mexFunction.f08
|
mexFunction.f08
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
mex_PROGRAMS = local_state_space_iteration_fortran
|
mex_PROGRAMS = local_state_space_iteration_fortran
|
||||||
|
|
||||||
local_state_space_iteration_fortran_FCFLAGS = $(AM_FCFLAGS) -Warray-temporaries -I../libkordersim
|
local_state_space_iteration_fortran_FCFLAGS = $(AM_FCFLAGS) -I../libkordersim
|
||||||
|
|
||||||
nodist_local_state_space_iteration_fortran_SOURCES = \
|
nodist_local_state_space_iteration_fortran_SOURCES = \
|
||||||
mexFunction.f08
|
mexFunction.f08
|
||||||
|
|
|
@ -16,21 +16,14 @@
|
||||||
! along with Dynare. If not, see <https://www.gnu.org/licenses/>.
|
! along with Dynare. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
! input:
|
! input:
|
||||||
! order the order of approximation, needs order+1 derivatives
|
! yhat values of endogenous variables
|
||||||
! nstat
|
! epsilon values of the exgogenous shock
|
||||||
! npred
|
! dr struct containing the folded tensors g_0, g_1, ...
|
||||||
! nboth
|
! M struct containing the model features
|
||||||
! nforw
|
! options struct containing the model options
|
||||||
! nexog
|
! udr struct containing the model unfolded tensors
|
||||||
! ystart starting value (full vector of endogenous)
|
|
||||||
! shocks matrix of shocks (nexog x number of period)
|
|
||||||
! vcov covariance matrix of shocks (nexog x nexog)
|
|
||||||
! seed integer seed
|
|
||||||
! ysteady full vector of decision rule's steady
|
|
||||||
! dr structure containing matrices of derivatives (g_0, g_1,…)
|
|
||||||
|
|
||||||
! output:
|
! output:
|
||||||
! res simulated results
|
! ynext simulated next-period results
|
||||||
|
|
||||||
subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
use iso_fortran_env
|
use iso_fortran_env
|
||||||
|
@ -45,14 +38,12 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
type(c_ptr), dimension(*), intent(out) :: plhs
|
type(c_ptr), dimension(*), intent(out) :: plhs
|
||||||
integer(c_int), intent(in), value :: nlhs, nrhs
|
integer(c_int), intent(in), value :: nlhs, nrhs
|
||||||
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 :: fdr, 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 :: order_var, ys, ys_reordered, restrict_var_list, dyu
|
||||||
real(real64), dimension(:,:), allocatable :: yhat, e, ynext, ynext_all
|
real(real64), dimension(:,:), allocatable :: yhat, e, ynext, ynext_all
|
||||||
type(pascal_triangle) :: p
|
|
||||||
type(uf_matching), dimension(:), allocatable :: matching
|
|
||||||
type(horner), dimension(:), allocatable :: h
|
type(horner), dimension(:), allocatable :: h
|
||||||
integer :: i, d, j, m, n
|
integer :: i, j, m, n
|
||||||
character(kind=c_char, len=10) :: fieldname
|
character(kind=c_char, len=10) :: fieldname
|
||||||
|
|
||||||
yhat_mx = prhs(1)
|
yhat_mx = prhs(1)
|
||||||
|
@ -63,9 +54,6 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
udr_mx = prhs(6)
|
udr_mx = prhs(6)
|
||||||
|
|
||||||
! Checking the consistence and validity of input arguments
|
! Checking the consistence and validity of input arguments
|
||||||
! if (nrhs /= 5 .or. nlhs /= 1) then
|
|
||||||
! call mexErrMsgTxt("Must have exactly 5 inputs and 1 output")
|
|
||||||
! end if
|
|
||||||
if (nrhs /= 6 .or. nlhs /= 1) then
|
if (nrhs /= 6 .or. nlhs /= 1) then
|
||||||
call mexErrMsgTxt("Must have exactly 5 inputs and 1 output")
|
call mexErrMsgTxt("Must have exactly 5 inputs and 1 output")
|
||||||
end if
|
end if
|
||||||
|
@ -142,7 +130,7 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction')
|
||||||
yhat = reshape(mxGetPr(yhat_mx), [nys, nparticles])
|
yhat = reshape(mxGetPr(yhat_mx), [nys, nparticles])
|
||||||
e = reshape(mxGetPr(epsilon_mx), [exo_nbr, nparticles])
|
e = reshape(mxGetPr(epsilon_mx), [exo_nbr, nparticles])
|
||||||
|
|
||||||
allocate(h(0:order), fdr(0:order), udr(0:order))
|
allocate(h(0:order), udr(0:order))
|
||||||
do i = 0, order
|
do i = 0, order
|
||||||
write (fieldname, '(a2, i1)') "g_", i
|
write (fieldname, '(a2, i1)') "g_", i
|
||||||
tmp = mxGetField(udr_mx, 1_mwIndex, trim(fieldname))
|
tmp = mxGetField(udr_mx, 1_mwIndex, trim(fieldname))
|
||||||
|
|
Loading…
Reference in New Issue