From 65a3bc39efed5a5c62082efc4581ee401aa05395 Mon Sep 17 00:00:00 2001 From: schnetter Date: Thu, 5 Oct 2006 06:24:57 +0000 Subject: Correct one-off error in the check that the boundary regions do not overlap. Check the number of ghost zones as well. git-svn-id: https://svn.cct.lsu.edu/repos/numrel/LSUThorns/SummationByParts/trunk@80 f69c4107-0314-4c4f-9ad4-17e986b73f4a --- src/Derivatives_8_4.F90 | 8 +++++--- src/Derivatives_8_4_min_err_coeff.F90 | 15 +++++++++++---- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/src/Derivatives_8_4.F90 b/src/Derivatives_8_4.F90 index 910a523..025ae27 100644 --- a/src/Derivatives_8_4.F90 +++ b/src/Derivatives_8_4.F90 @@ -167,6 +167,8 @@ subroutine deriv_gf_8_4 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 4) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -255,7 +257,7 @@ subroutine deriv_gf_8_4 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(12,8) * var(ni-11,:,:) ) * idel ir = ni - 8 end if - if (il > ir) call CCTK_WARN (0, "domain too small") + if (il > ir+1) call CCTK_WARN (0, "domain too small") dvar(il:ir,:,:) = ( a(1) * ( var(il+1:ir+1,:,:) - & var(il-1:ir-1,:,:) ) + & a(2) * ( var(il+2:ir+2,:,:) - & @@ -354,7 +356,7 @@ subroutine deriv_gf_8_4 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(12,8) * var(:,nj-11,:) ) * idel jr = nj - 8 end if - if (jl > jr) call CCTK_WARN (0, "domain too small") + if (jl > jr+1) call CCTK_WARN (0, "domain too small") dvar(:,jl:jr,:) = ( a(1) * ( var(:,jl+1:jr+1,:) - & var(:,jl-1:jr-1,:) ) + & a(2) * ( var(:,jl+2:jr+2,:) - & @@ -454,7 +456,7 @@ subroutine deriv_gf_8_4 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(12,8) * var(:,:,nk-11) ) * idel kr = nk - 8 end if - if (kl > kr) call CCTK_WARN (0, "domain too small") + if (kl > kr+1) call CCTK_WARN (0, "domain too small") dvar(:,:,kl:kr) = ( a(1) * ( var(:,:,kl+1:kr+1) - & var(:,:,kl-1:kr-1) ) + & a(2) * ( var(:,:,kl+2:kr+2) - & diff --git a/src/Derivatives_8_4_min_err_coeff.F90 b/src/Derivatives_8_4_min_err_coeff.F90 index 3649f58..944e177 100644 --- a/src/Derivatives_8_4_min_err_coeff.F90 +++ b/src/Derivatives_8_4_min_err_coeff.F90 @@ -133,6 +133,8 @@ subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 4) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -221,7 +223,7 @@ subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(12,8) * var(ni-11,:,:) ) * idel ir = ni - 8 end if - if (il > ir) call CCTK_WARN (0, "domain too small") + if (il > ir+1) call CCTK_WARN (0, "domain too small") dvar(il:ir,:,:) = ( a(1) * ( var(il+1:ir+1,:,:) - & var(il-1:ir-1,:,:) ) + & a(2) * ( var(il+2:ir+2,:,:) - & @@ -320,7 +322,7 @@ subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(12,8) * var(:,nj-11,:) ) * idel jr = nj - 8 end if - if (jl > jr) call CCTK_WARN (0, "domain too small") + if (jl > jr+1) call CCTK_WARN (0, "domain too small") dvar(:,jl:jr,:) = ( a(1) * ( var(:,jl+1:jr+1,:) - & var(:,jl-1:jr-1,:) ) + & a(2) * ( var(:,jl+2:jr+2,:) - & @@ -420,7 +422,7 @@ subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(12,8) * var(:,:,nk-11) ) * idel kr = nk - 8 end if - if (kl > kr) call CCTK_WARN (0, "domain too small") + if (kl > kr+1) call CCTK_WARN (0, "domain too small") dvar(:,:,kl:kr) = ( a(1) * ( var(:,:,kl+1:kr+1) - & var(:,:,kl-1:kr-1) ) + & a(2) * ( var(:,:,kl+2:kr+2) - & @@ -455,7 +457,7 @@ subroutine up_deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva CCTK_REAL, dimension(12,8), save :: q1, q2 CCTK_REAL :: idel - CCTK_INT :: il, ir, jl, jr, kl, kr, j, k + CCTK_INT :: il, ir, jl, jr, kl, kr logical, save :: first = .true. @@ -679,6 +681,8 @@ subroutine up_deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva idel = 1.0_wp / delta + if (gsize < 4) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -965,6 +969,7 @@ subroutine up_deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva end where ir = ni - 8 end if + if (il > ir+1) call CCTK_WARN (0, "domain too small") where ( up(il:ir,:,:) < zero ) dvar(il:ir,:,:) = ( a1(-4) * var(il-4:ir-4,:,:) + & a1(-3) * var(il-3:ir-3,:,:) + & @@ -1274,6 +1279,7 @@ subroutine up_deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva end where jr = nj - 8 end if + if (jl > jr+1) call CCTK_WARN (0, "domain too small") where ( up(:,jl:jr,:) < zero ) dvar(:,jl:jr,:) = ( a1(-4) * var(:,jl-4:jr-4,:) + & a1(-3) * var(:,jl-3:jr-3,:) + & @@ -1584,6 +1590,7 @@ subroutine up_deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva end where kr = nk - 8 end if + if (kl > kr+1) call CCTK_WARN (0, "domain too small") where ( up(:,:,kl:kr) < zero ) dvar(:,:,kl:kr) = ( a1(-4) * var(:,:,kl-4:kr-4) + & a1(-3) * var(:,:,kl-3:kr-3) + & -- cgit v1.2.3