Skip to content

Commit

Permalink
Add Fortran inteface for FillCoarsePatch for face variables
Browse files Browse the repository at this point in the history
  • Loading branch information
@WeiqunZhang
WeiqunZhang committed Sep 15, 2023
1 parent 6eb91be commit 06987b6
Show file tree
Hide file tree
Showing 2 changed files with 197 additions and 14 deletions.
37 changes: 37 additions & 0 deletions Src/F_Interfaces/AmrCore/AMReX_fillpatch_fi.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -198,4 +198,41 @@ extern "C"
FIInterpHook(pre_interp),
FIInterpHook(post_interp));
}

void amrex_fi_fillcoarsepatch_faces (MultiFab* mf[], Real time, MultiFab* cmf[],
int scomp, int dcomp, int ncomp,
const Geometry* cgeom, const Geometry* fgeom,
FPhysBC::fill_physbc_funptr_t cfill[],
FPhysBC::fill_physbc_funptr_t ffill[],
int rr, int interp_id,
int* lo_bc[], int* hi_bc[],
INTERP_HOOK_ARR pre_interp, INTERP_HOOK_ARR post_interp)
{
Array<Vector<BCRec>, AMREX_SPACEDIM> bcs;
for (int d = 0; d < AMREX_SPACEDIM; ++d)
{
for (int i = 0; i < ncomp; ++i)
{ bcs[d].emplace_back(lo_bc[d*(scomp+ncomp)+i+scomp],
hi_bc[d*(scomp+ncomp)+i+scomp]); }
}

Array<MultiFab*, AMREX_SPACEDIM> a_mf {AMREX_D_DECL( mf[0], mf[1], mf[2])};
Array<MultiFab*, AMREX_SPACEDIM> a_cmf{AMREX_D_DECL(cmf[0],cmf[1],cmf[2])};

Array<FPhysBC, AMREX_SPACEDIM> cbc{ AMREX_D_DECL( FPhysBC(cfill[0], cgeom),
FPhysBC(cfill[1], cgeom),
FPhysBC(cfill[2], cgeom)) };
Array<FPhysBC, AMREX_SPACEDIM> fbc{ AMREX_D_DECL( FPhysBC(ffill[0], fgeom),
FPhysBC(ffill[1], fgeom),
FPhysBC(ffill[2], fgeom)) };

amrex::InterpFromCoarseLevel(a_mf, time, a_cmf,
scomp, dcomp, ncomp,
*cgeom, *fgeom,
cbc, 0, fbc, 0,
IntVect{AMREX_D_DECL(rr,rr,rr)},
interp[interp_id], bcs, 0,
FIArrInterpHook(pre_interp),
FIArrInterpHook(post_interp));
}
}
174 changes: 160 additions & 14 deletions Src/F_Interfaces/AmrCore/AMReX_fillpatch_mod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,11 @@ module amrex_fillpatch_module
module procedure amrex_fillpatch_two_faces
end interface amrex_fillpatch

interface amrex_fillcoarsepatch
module procedure amrex_fillcoarsepatch_default
module procedure amrex_fillcoarsepatch_faces
end interface amrex_fillcoarsepatch

interface
subroutine amrex_interp_hook_proc (lo, hi, d, dlo, dhi, nd, icomp, ncomp) bind(c)
import
Expand All @@ -23,6 +28,29 @@ subroutine amrex_interp_hook_proc (lo, hi, d, dlo, dhi, nd, icomp, ncomp) bind(c
integer(c_int), intent(in), value :: nd, icomp, ncomp
real(amrex_real), intent(inout) :: d(dlo(1):dhi(1),dlo(2):dhi(2),dlo(3):dhi(3),nd)
end subroutine amrex_interp_hook_proc

subroutine amrex_interp_hook_arr_proc (lo, hi, dx, dxlo, dxhi, &
#if (AMREX_SPACEDIM > 1)
& dy, dylo, dyhi, &
#endif
#if (AMREX_SPACEDIM > 2)
& dz, dzlo, dzhi, &
#endif
& nd, icomp, ncomp) bind(c)
import
implicit none
integer(c_int), intent(in) :: lo(3), hi(3), dxlo(3), dxhi(3)
integer(c_int), intent(in), value :: nd, icomp, ncomp
real(amrex_real), intent(inout) :: dx(dxlo(1):dxhi(1),dxlo(2):dxhi(2),dxlo(3):dxhi(3),nd)
#if (AMREX_SPACEDIM > 1)
integer(c_int), intent(in) :: dylo(3), dyhi(3)
real(amrex_real), intent(inout) :: dy(dylo(1):dyhi(1),dylo(2):dyhi(2),dylo(3):dyhi(3),nd)
#endif
#if (AMREX_SPACEDIM > 2)
integer(c_int), intent(in) :: dzlo(3), dzhi(3)
real(amrex_real), intent(inout) :: dz(dzlo(1):dzhi(1),dzlo(2):dzhi(2),dzlo(3):dzhi(3),nd)
#endif
end subroutine amrex_interp_hook_arr_proc
end interface

interface
Expand Down Expand Up @@ -79,6 +107,20 @@ subroutine amrex_fi_fillcoarsepatch(mf, time, cmf, scomp, dcomp, ncomp, &
real(amrex_real), value :: time
integer, value :: scomp, dcomp, ncomp, rr, interp
end subroutine amrex_fi_fillcoarsepatch

subroutine amrex_fi_fillcoarsepatch_faces(mf, time, cmf, scomp, dcomp, ncomp, &
cgeom, fgeom, cfill, ffill, rr, interp, lo_bc, hi_bc, pre_interp, post_interp) &
bind(c)
import
implicit none
type(c_ptr), intent(in) :: mf(*), cmf(*)
type(c_ptr), value :: cgeom, fgeom
type(c_ptr), intent(in) :: lo_bc(*), hi_bc(*)
type(c_funptr), intent(in) :: cfill(*), ffill(*)
type(c_funptr), value :: pre_interp, post_interp
real(amrex_real), value :: time
integer, value :: scomp, dcomp, ncomp, rr, interp
end subroutine amrex_fi_fillcoarsepatch_faces
end interface

contains
Expand Down Expand Up @@ -203,16 +245,16 @@ subroutine amrex_fillpatch_two (mf, told_c, mfold_c, tnew_c, mfnew_c, geom_c, fi
end subroutine amrex_fillpatch_two

subroutine amrex_fillpatch_two_faces(mf, told_c, mfold_c, tnew_c, mfnew_c, geom_c, fill_physbc_cx, &
#if AMREX_SPACEDIM>1
#if (AMREX_SPACEDIM > 1)
& fill_physbc_cy, &
#if AMREX_SPACEDIM>2
#if (AMREX_SPACEDIM > 2)
& fill_physbc_cz, &
#endif
#endif
& told_f, mfold_f, tnew_f, mfnew_f, geom_f, fill_physbc_fx, &
#if AMREX_SPACEDIM>1
#if (AMREX_SPACEDIM > 1)
& fill_physbc_fy, &
#if AMREX_SPACEDIM>2
#if (AMREX_SPACEDIM > 2)
& fill_physbc_fz, &
#endif
#endif
Expand All @@ -222,13 +264,19 @@ subroutine amrex_fillpatch_two_faces(mf, told_c, mfold_c, tnew_c, mfnew_c, geom_
type(amrex_multifab), intent(in ) :: mfold_c(amrex_spacedim), mfnew_c(amrex_spacedim)
type(amrex_multifab), intent(in ) :: mfold_f(amrex_spacedim), mfnew_f(amrex_spacedim)
integer, intent(in) :: scomp, dcomp, ncomp, rr, interp
! (BC dir , comp , MF)
integer, dimension(amrex_spacedim,scomp+ncomp-1,amrex_spacedim), target, intent(in) :: lo_bc, hi_bc
real(amrex_real), intent(in) :: told_c, tnew_c, told_f, tnew_f, time
type(amrex_geometry), intent(in) :: geom_c, geom_f
procedure(amrex_physbc_proc) :: fill_physbc_cx, fill_physbc_cy, fill_physbc_cz
procedure(amrex_physbc_proc) :: fill_physbc_fx, fill_physbc_fy, fill_physbc_fz
procedure(amrex_interp_hook_proc), optional :: pre_interp
procedure(amrex_interp_hook_proc), optional :: post_interp
procedure(amrex_physbc_proc) :: fill_physbc_cx, fill_physbc_fx
#if (AMREX_SPACEDIM > 1)
procedure(amrex_physbc_proc) :: fill_physbc_cy, fill_physbc_fy
#endif
#if (AMREX_SPACEDIM > 2)
procedure(amrex_physbc_proc) :: fill_physbc_cz, fill_physbc_fz
#endif
procedure(amrex_interp_hook_arr_proc), optional :: pre_interp
procedure(amrex_interp_hook_arr_proc), optional :: post_interp

real(amrex_real) :: teps
real(amrex_real) :: c_time(2), f_time(2)
Expand Down Expand Up @@ -332,10 +380,10 @@ subroutine amrex_fillpatch_two_faces(mf, told_c, mfold_c, tnew_c, mfnew_c, geom_
end subroutine amrex_fillpatch_two_faces


subroutine amrex_fillcoarsepatch (mf, told_c, mfold_c, tnew_c, mfnew_c, &
& geom_c, fill_physbc_c, geom_f, fill_physbc_f, &
& time, scomp, dcomp, ncomp, rr, interp, lo_bc, hi_bc, &
& pre_interp, post_interp)
subroutine amrex_fillcoarsepatch_default (mf, told_c, mfold_c, tnew_c, mfnew_c, &
& geom_c, fill_physbc_c, geom_f, fill_physbc_f, &
& time, scomp, dcomp, ncomp, rr, interp, lo_bc, hi_bc, &
& pre_interp, post_interp)
type(amrex_multifab), intent(inout) :: mf
type(amrex_multifab), intent(in ) :: mfold_c, mfnew_c
integer, intent(in) :: scomp, dcomp, ncomp, rr, interp
Expand All @@ -359,7 +407,7 @@ subroutine amrex_fillcoarsepatch (mf, told_c, mfold_c, tnew_c, mfnew_c, &
else if (abs(time-told_c) .le. teps) then
c_mf = mfold_c%p
else
call amrex_abort("amrex_fillcoarsepatch: how did this happen?")
call amrex_abort("amrex_fillcoarsepatch_default: how did this happen?")
end if

do i = 1, scomp-1
Expand All @@ -383,6 +431,104 @@ subroutine amrex_fillcoarsepatch (mf, told_c, mfold_c, tnew_c, mfnew_c, &
& c_funloc(fill_physbc_f), &
& rr, interp, lo_bc_ptr, hi_bc_ptr,&
& pre_interp_ptr, post_interp_ptr)
end subroutine amrex_fillcoarsepatch
end subroutine amrex_fillcoarsepatch_default


subroutine amrex_fillcoarsepatch_faces (mf, told_c, mfold_c, tnew_c, mfnew_c, &
& geom_c, fill_physbc_cx, &
#if (AMREX_SPACEDIM > 1)
& fill_physbc_cy, &
#if (AMREX_SPACEDIM > 2)
& fill_physbc_cz, &
#endif
#endif
& geom_f, fill_physbc_fx, &
#if (AMREX_SPACEDIM > 1)
& fill_physbc_fy, &
#if (AMREX_SPACEDIM > 2)
& fill_physbc_fz, &
#endif
#endif
& time, scomp, dcomp, ncomp, rr, interp, lo_bc, hi_bc, &
& pre_interp, post_interp)
type(amrex_multifab), intent(inout) :: mf(amrex_spacedim)
type(amrex_multifab), intent(in ) :: mfold_c(amrex_spacedim), mfnew_c(amrex_spacedim)
integer, intent(in) :: scomp, dcomp, ncomp, rr, interp
! (BC dir , comp , MF)
integer, dimension(amrex_spacedim,scomp+ncomp-1,amrex_spacedim), target, intent(in) :: lo_bc, hi_bc
real(amrex_real), intent(in) :: told_c, tnew_c, time
type(amrex_geometry), intent(in) :: geom_c, geom_f
procedure(amrex_physbc_proc) :: fill_physbc_cx, fill_physbc_fx
#if (AMREX_SPACEDIM > 1)
procedure(amrex_physbc_proc) :: fill_physbc_cy, fill_physbc_fy
#endif
#if (AMREX_SPACEDIM > 2)
procedure(amrex_physbc_proc) :: fill_physbc_cz, fill_physbc_fz
#endif
procedure(amrex_interp_hook_arr_proc), optional :: pre_interp
procedure(amrex_interp_hook_arr_proc), optional :: post_interp

real(amrex_real) :: teps
type(c_ptr) :: faces(amrex_spacedim)
type(c_ptr) :: c_mf(amrex_spacedim)
type(c_funptr) :: cfill(amrex_spacedim), ffill(amrex_spacedim)
type(c_ptr) :: lo_bc_ptr(amrex_spacedim*(scomp+ncomp-1)), hi_bc_ptr(amrex_spacedim*(scomp+ncomp-1))
type(c_funptr) :: pre_interp_ptr, post_interp_ptr
integer :: i, nc, dim, mfid

cfill(1) = c_funloc(fill_physbc_cx)
ffill(1) = c_funloc(fill_physbc_fx)
#if (AMREX_SPACEDIM >= 2)
cfill(2) = c_funloc(fill_physbc_cy)
ffill(2) = c_funloc(fill_physbc_fy)
#if (AMREX_SPACEDIM >= 3)
cfill(3) = c_funloc(fill_physbc_cz)
ffill(3) = c_funloc(fill_physbc_fz)
#endif
#endif

do dim = 1, amrex_spacedim
faces(dim) = mf(dim)%p
end do

! coarse level
teps = 1.e-4_amrex_real * abs(tnew_c - told_c)
if (abs(time-tnew_c) .le. teps) then
do dim = 1, amrex_spacedim
c_mf(dim) = mfnew_c(dim)%p
end do
else if (abs(time-told_c) .le. teps) then
do dim = 1, amrex_spacedim
c_mf(dim) = mfold_c(dim)%p
end do
else
call amrex_abort("amrex_fillcoarsepatch_faces: how did this happen?")
end if

! lo_bc & hi_bc: (BC dir, comp, MF)
nc = scomp+ncomp-1
do mfid = 1, amrex_spacedim
do i = 1, scomp-1
lo_bc_ptr((mfid-1)*nc + i) = c_null_ptr
hi_bc_ptr((mfid-1)*nc + i) = c_null_ptr
end do
do i = scomp, nc
lo_bc_ptr((mfid-1)*nc + i) = c_loc(lo_bc(1,i,mfid))
hi_bc_ptr((mfid-1)*nc + i) = c_loc(hi_bc(1,i,mfid))
end do
end do

pre_interp_ptr = c_null_funptr
if (present(pre_interp)) pre_interp_ptr = c_funloc(pre_interp)
post_interp_ptr = c_null_funptr
if (present(post_interp)) post_interp_ptr = c_funloc(post_interp)

! scomp-1 and dcomp-1 because of Fortran index starts with 1
call amrex_fi_fillcoarsepatch_faces(faces, time, c_mf, scomp-1, dcomp-1, ncomp, &
& geom_c%p, geom_f%p, &
& cfill, ffill, &
& rr, interp, lo_bc_ptr, hi_bc_ptr,&
& pre_interp_ptr, post_interp_ptr)
end subroutine amrex_fillcoarsepatch_faces

end module amrex_fillpatch_module

0 comments on commit 06987b6

Please sign in to comment.