From 582929664d74969183c6339f376f9ef6d7b41f7d Mon Sep 17 00:00:00 2001 From: Weiqun Zhang Date: Thu, 14 Sep 2023 08:54:15 -0700 Subject: [PATCH] Fix Fortran interface for FillPatch for face variables (#3541) ## Summary The stride was wrong when copying MultiFab pointers from a Fortran array to a Vector of Array of MultiFab pointers. This also fixes cases when the user passes t_new followed by t_old, instead of the other order. The issue was then teps was negative. This was a minor issue, because the FillPatch function in C++ does not care about the order. ## Additional background https://github.com/AMReX-Codes/amrex/issues/327#issuecomment-1716356603 ## Checklist The proposed changes: - [x] fix a bug or incorrect behavior in AMReX - [ ] add new capabilities to AMReX - [ ] changes answers in the test suite to more than roundoff level - [ ] are likely to significantly affect the results of downstream AMReX users - [ ] include documentation in the code and/or rst files, if appropriate --- .../AmrCore/AMReX_fillpatch_fi.cpp | 4 +-- .../AmrCore/AMReX_fillpatch_mod.F90 | 36 +++++++++---------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/Src/F_Interfaces/AmrCore/AMReX_fillpatch_fi.cpp b/Src/F_Interfaces/AmrCore/AMReX_fillpatch_fi.cpp index dc083cd2c7c..db478871241 100644 --- a/Src/F_Interfaces/AmrCore/AMReX_fillpatch_fi.cpp +++ b/Src/F_Interfaces/AmrCore/AMReX_fillpatch_fi.cpp @@ -147,11 +147,11 @@ extern "C" Vector > va_fmf(nf); for (int i = 0; i < nc; ++i) { for (int d = 0; d < AMREX_SPACEDIM; ++d) - { va_cmf[i][d] = cmf[i+d*AMREX_SPACEDIM]; } + { va_cmf[i][d] = cmf[i*AMREX_SPACEDIM+d]; } } for (int i = 0; i < nf; ++i) { for (int d = 0; d < AMREX_SPACEDIM; ++d) - { va_fmf[i][d] = fmf[i+d*AMREX_SPACEDIM]; } + { va_fmf[i][d] = fmf[i*AMREX_SPACEDIM+d]; } } Array cbc{ AMREX_D_DECL( FPhysBC(cfill[0], cgeom), diff --git a/Src/F_Interfaces/AmrCore/AMReX_fillpatch_mod.F90 b/Src/F_Interfaces/AmrCore/AMReX_fillpatch_mod.F90 index f6410f9122a..119544a345d 100644 --- a/Src/F_Interfaces/AmrCore/AMReX_fillpatch_mod.F90 +++ b/Src/F_Interfaces/AmrCore/AMReX_fillpatch_mod.F90 @@ -97,12 +97,12 @@ subroutine amrex_fillpatch_single (mf, told, mfold, tnew, mfnew, geom, fill_phys type(c_ptr) :: smf(2) integer :: ns - teps = 1.e-4_amrex_real * (tnew - told) - if (abs(time-tnew) .lt. teps) then + teps = 1.e-4_amrex_real * abs(tnew - told) + if (abs(time-tnew) .le. teps) then ns = 1 smf (1) = mfnew%p stime(1) = tnew - else if (abs(time-told) .lt. teps) then + else if (abs(time-told) .le. teps) then ns = 1 smf (1) = mfold%p stime(1) = told @@ -142,12 +142,12 @@ subroutine amrex_fillpatch_two (mf, told_c, mfold_c, tnew_c, mfnew_c, geom_c, fi integer :: ncrse, nfine, i ! coarse level - teps = 1.e-4_amrex_real * (tnew_c - told_c) - if (abs(time-tnew_c) .lt. teps) then + teps = 1.e-4_amrex_real * abs(tnew_c - told_c) + if (abs(time-tnew_c) .le. teps) then ncrse= 1 c_mf (1) = mfnew_c%p c_time(1) = tnew_c - else if (abs(time-told_c) .lt. teps) then + else if (abs(time-told_c) .le. teps) then ncrse= 1 c_mf (1) = mfold_c%p c_time(1) = told_c @@ -160,12 +160,12 @@ subroutine amrex_fillpatch_two (mf, told_c, mfold_c, tnew_c, mfnew_c, geom_c, fi end if ! fine level - teps = 1.e-4_amrex_real * (tnew_f - told_f) - if (abs(time-tnew_f) .lt. teps) then + teps = 1.e-4_amrex_real * abs(tnew_f - told_f) + if (abs(time-tnew_f) .le. teps) then nfine= 1 f_mf (1) = mfnew_f%p f_time(1) = tnew_f - else if (abs(time-told_f) .lt. teps) then + else if (abs(time-told_f) .le. teps) then nfine= 1 f_mf (1) = mfold_f%p f_time(1) = told_f @@ -256,14 +256,14 @@ subroutine amrex_fillpatch_two_faces(mf, told_c, mfold_c, tnew_c, mfnew_c, geom_ end do ! coarse level - teps = 1.e-4_amrex_real * (tnew_c - told_c) - if (abs(time-tnew_c) .lt. teps) then + teps = 1.e-4_amrex_real * abs(tnew_c - told_c) + if (abs(time-tnew_c) .le. teps) then ncrse= 1 c_time(1) = tnew_c do dim = 1, amrex_spacedim c_mf(dim) = mfnew_c(dim)%p end do - else if (abs(time-told_c) .lt. teps) then + else if (abs(time-told_c) .le. teps) then ncrse= 1 c_time(1) = told_c do dim = 1, amrex_spacedim @@ -280,14 +280,14 @@ subroutine amrex_fillpatch_two_faces(mf, told_c, mfold_c, tnew_c, mfnew_c, geom_ end if ! fine level - teps = 1.e-4_amrex_real * (tnew_f - told_f) - if (abs(time-tnew_f) .lt. teps) then + teps = 1.e-4_amrex_real * abs(tnew_f - told_f) + if (abs(time-tnew_f) .le. teps) then nfine= 1 f_time(1) = tnew_f do dim = 1, amrex_spacedim f_mf(dim) = mfnew_f(dim)%p enddo - else if (abs(time-told_f) .lt. teps) then + else if (abs(time-told_f) .le. teps) then nfine= 1 f_time(1) = told_f do dim = 1, amrex_spacedim @@ -353,10 +353,10 @@ subroutine amrex_fillcoarsepatch (mf, told_c, mfold_c, tnew_c, mfnew_c, & integer :: i ! coarse level - teps = 1.e-4_amrex_real * (tnew_c - told_c) - if (abs(time-tnew_c) .lt. teps) then + teps = 1.e-4_amrex_real * abs(tnew_c - told_c) + if (abs(time-tnew_c) .le. teps) then c_mf = mfnew_c%p - else if (abs(time-told_c) .lt. teps) then + else if (abs(time-told_c) .le. teps) then c_mf = mfold_c%p else call amrex_abort("amrex_fillcoarsepatch: how did this happen?")