From e722e908e5fdee363b405a7c2a3aea149b07f785 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Villemot?= Date: Fri, 24 Sep 2021 16:18:10 +0200 Subject: [PATCH] k_order_simul+local_state_space_iteration_fortran MEX: fix gfortran warnings --- mex/sources/k_order_simul/mexFunction.f08 | 28 +++++++++---------- .../mexFunction.f08 | 15 +++++----- 2 files changed, 21 insertions(+), 22 deletions(-) diff --git a/mex/sources/k_order_simul/mexFunction.f08 b/mex/sources/k_order_simul/mexFunction.f08 index bf1f69ac6..2c3d60590 100644 --- a/mex/sources/k_order_simul/mexFunction.f08 +++ b/mex/sources/k_order_simul/mexFunction.f08 @@ -45,9 +45,9 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction') type(pol), dimension(:), allocatable, target :: fdr, udr integer :: order, nstatic, npred, nboth, nfwrd, exo_nbr, endo_nbr, nys, nvar, nper 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(uf_matching), dimension(:), allocatable :: matching type(horner), dimension(:), allocatable :: h integer :: i, t, d, m, n 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 call mexErrMsgTxt("ystart should have nstat+npred+nboth+nforw rows") end if - allocate(ystart(endo_nbr)) - ystart = mxGetPr(ystart_mx) + ystart => mxGetPr(ystart_mx) if (exo_nbr /= int(mxGetM(shocks_mx))) then 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 call mexErrMsgTxt("ysteady should have nstat+npred+nboth+nforw rows") end if - allocate(ysteady(endo_nbr)) - ysteady = mxGetPr(ysteady_mx) + ysteady => mxGetPr(ysteady_mx) allocate(h(0:order), fdr(0:order), udr(0:order)) do i = 0, order @@ -146,13 +144,15 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction') if (order > 1) then ! Compute the useful binomial coefficients from Pascal's triangle p = pascal_triangle(nvar+order-1) - allocate(matching(2:order)) - ! Pinpointing the corresponding offsets between folded and unfolded tensors - do d=2,order - allocate(matching(d)%folded(nvar**d)) - call fill_folded_indices(matching(d)%folded, nvar, d, p) - udr(d)%g = fdr(d)%g(:,matching(d)%folded) - end do + block + type(uf_matching), dimension(2:order) :: matching + ! Pinpointing the corresponding offsets between folded and unfolded tensors + do d=2,order + allocate(matching(d)%folded(nvar**d)) + call fill_folded_indices(matching(d)%folded, nvar, d, p) + udr(d)%g = fdr(d)%g(:,matching(d)%folded) + end do + end block end if allocate(dyu(nvar), ystart_pred(nys), ysteady_pred(nys), sim(endo_nbr,nper)) @@ -177,4 +177,4 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction') plhs(1) = mxCreateDoubleMatrix(int(endo_nbr, mwSize), int(nper, mwSize), mxREAL) mxGetPr(plhs(1)) = reshape(sim, (/size(sim)/)) -end subroutine mexFunction \ No newline at end of file +end subroutine mexFunction diff --git a/mex/sources/local_state_space_iteration_fortran/mexFunction.f08 b/mex/sources/local_state_space_iteration_fortran/mexFunction.f08 index a40a554a6..ae3662aa2 100644 --- a/mex/sources/local_state_space_iteration_fortran/mexFunction.f08 +++ b/mex/sources/local_state_space_iteration_fortran/mexFunction.f08 @@ -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(pol), dimension(:), allocatable, target :: udr 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 type(horner), dimension(:), allocatable :: h 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 call mexErrMsgTxt("Field dr.order_var should be a double precision vector with endo_nbr elements") end if - allocate(order_var(endo_nbr)) - order_var = mxGetPr(order_var_mx) + order_var => mxGetPr(order_var_mx) end associate associate (ys_mx => mxGetField(dr_mx, 1_mwIndex, "ys")) 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") end if - allocate(ys(endo_nbr), ys_reordered(endo_nbr)) - ys = mxGetPr(ys_mx) + ys => mxGetPr(ys_mx) ! Construct the reordered steady state + allocate(ys_reordered(endo_nbr)) do i=1, endo_nbr ys_reordered(i) = ys(int(order_var(i))) 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") end if 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 nparticles = int(mxGetN(yhat_mx)); @@ -158,4 +157,4 @@ subroutine mexFunction(nlhs, plhs, nrhs, prhs) bind(c, name='mexFunction') plhs(1) = mxCreateDoubleMatrix(int(size(restrict_var_list), mwSize), int(nparticles, mwSize), mxREAL) mxGetPr(plhs(1)) = reshape(ynext, [size(ynext)]) -end subroutine mexFunction \ No newline at end of file +end subroutine mexFunction