From 7fb71203958220c0d3c11b7aeadcd60cb4df74a2 Mon Sep 17 00:00:00 2001 From: schnetter Date: Thu, 5 Oct 2006 16:20:52 +0000 Subject: Check that the boundary regions (where the stencils need to be one-sided) do not overlap. Check the number of ghost zones. git-svn-id: https://svn.cct.lsu.edu/repos/numrel/LSUThorns/SummationByParts/trunk@81 f69c4107-0314-4c4f-9ad4-17e986b73f4a --- src/Derivatives_2_1.F90 | 10 ++++++++++ src/Derivatives_4_2.F90 | 10 ++++++++++ src/Derivatives_4_3.F90 | 5 +++++ src/Derivatives_4_3_min_err_coeff.F90 | 5 +++++ src/Derivatives_6_3.F90 | 5 +++++ src/Derivatives_6_3_min_err_coeff.F90 | 10 ++++++++++ src/Derivatives_6_5.F90 | 5 +++++ src/Derivatives_6_5_min_err_coeff.F90 | 5 +++++ 8 files changed, 55 insertions(+) diff --git a/src/Derivatives_2_1.F90 b/src/Derivatives_2_1.F90 index 8192a71..788d325 100644 --- a/src/Derivatives_2_1.F90 +++ b/src/Derivatives_2_1.F90 @@ -37,6 +37,8 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 1) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -55,6 +57,7 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(2,1) * var(ni-1,:,:) ) * idel ir = ni - 2 end if + 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,:,:) ) * idel case (1) direction if ( zero_derivs_y /= 0 ) then @@ -76,6 +79,7 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(2,1) * var(:,nj-1,:) ) * idel jr = nj - 2 end if + 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,:) ) * idel end if @@ -99,6 +103,7 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(2,1) * var(:,:,nk-1) ) * idel kr = nk - 2 end if + 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) ) * idel end if @@ -159,6 +164,8 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) idel = 1.0_wp / delta + if (gsize < 1) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -199,6 +206,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) end where ir = ni - 2 end if + if (il > ir+1) call CCTK_WARN (0, "domain too small") where ( up(il:ir,:,:) < zero ) dvar(il:ir,:,:) = ( a1(-1) * var(il-1:ir-1,:,:) + & a1(0) * var(il:ir,:,:) + & @@ -250,6 +258,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) end where jr = nj - 2 end if + if (jl > jr+1) call CCTK_WARN (0, "domain too small") where ( up(:,jl:jr,:) < zero ) dvar(:,jl:jr,:) = ( a1(-1) * var(:,jl-1:jr-1,:) + & a1(0) * var(:,jl:jr,:) + & @@ -302,6 +311,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) end where kr = nk - 2 end if + if (kl > kr+1) call CCTK_WARN (0, "domain too small") where ( up(:,:,kl:kr) < zero ) dvar(:,:,kl:kr) = ( a1(-1) * var(:,:,kl-1:kr-1) + & a1(0) * var(:,:,kl:kr) + & diff --git a/src/Derivatives_4_2.F90 b/src/Derivatives_4_2.F90 index 5cec73a..fb6888f 100644 --- a/src/Derivatives_4_2.F90 +++ b/src/Derivatives_4_2.F90 @@ -47,6 +47,8 @@ subroutine deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 2) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -80,6 +82,7 @@ subroutine deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(4,1) * var(ni-3,:,:) ) * idel ir = ni - 4 end if + 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,:,:) - & @@ -119,6 +122,7 @@ subroutine deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(4,1) * var(:,nj-3,:) ) * idel jr = nj - 4 end if + 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,:) - & @@ -159,6 +163,7 @@ subroutine deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(4,1) * var(:,:,nk-3) ) * idel kr = nk - 4 end if + 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) - & @@ -261,6 +266,8 @@ subroutine up_deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) idel = 1.0_wp / delta + if (gsize < 2) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -355,6 +362,7 @@ subroutine up_deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) end where ir = ni - 4 end if + if (il > ir+1) call CCTK_WARN (0, "domain too small") where ( up(il:ir,:,:) < zero ) dvar(il:ir,:,:) = ( a1(-2) * var(il-2:ir-2,:,:) + & a1(-1) * var(il-1:ir-1,:,:) + & @@ -412,6 +420,7 @@ subroutine up_deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) if ( bb(2) == 0 ) then jr = nj - gsize else + if (jl > jr+1) call CCTK_WARN (0, "domain too small") where ( up(:,nj-3,:) < zero ) dvar(:,nj-3,:) = - ( q2(1,4) * var(:,nj,:) + & q2(2,4) * var(:,nj-1,:) + & @@ -574,6 +583,7 @@ subroutine up_deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) end where kr = nk - 4 end if + if (kl > kr+1) call CCTK_WARN (0, "domain too small") where ( up(:,:,kl:kr) < zero ) dvar(:,:,kl:kr) = ( a1(-2) * var(:,:,kl-2:kr-2) + & a1(-1) * var(:,:,kl-1:kr-1) + & diff --git a/src/Derivatives_4_3.F90 b/src/Derivatives_4_3.F90 index db7ebda..85c6715 100644 --- a/src/Derivatives_4_3.F90 +++ b/src/Derivatives_4_3.F90 @@ -87,6 +87,8 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 1) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -134,6 +136,7 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(4,1) * var(ni-3,:,:) ) * idel ir = ni - 5 end if + 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,:,:) - & @@ -187,6 +190,7 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(4,1) * var(:,nj-3,:) ) * idel jr = nj - 5 end if + 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,:) - & @@ -241,6 +245,7 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(4,1) * var(:,:,nk-3) ) * idel kr = nk - 5 end if + 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_4_3_min_err_coeff.F90 b/src/Derivatives_4_3_min_err_coeff.F90 index 8c2566d..b42d857 100644 --- a/src/Derivatives_4_3_min_err_coeff.F90 +++ b/src/Derivatives_4_3_min_err_coeff.F90 @@ -71,6 +71,8 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 2) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -121,6 +123,7 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(5,1) * var(ni-4,:,:) ) * idel ir = ni - 5 end if + 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,:,:) - & @@ -177,6 +180,7 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(5,1) * var(:,nj-4,:) ) * idel jr = nj - 5 end if + 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,:) - & @@ -234,6 +238,7 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(5,1) * var(:,:,nk-4) ) * idel kr = nk - 5 end if + 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_6_3.F90 b/src/Derivatives_6_3.F90 index 4c8643a..0e1b024 100644 --- a/src/Derivatives_6_3.F90 +++ b/src/Derivatives_6_3.F90 @@ -60,6 +60,8 @@ subroutine deriv_gf_6_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 3) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -113,6 +115,7 @@ subroutine deriv_gf_6_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(9,6) * var(ni-8,:,:) ) * idel ir = ni - 6 end if + 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,:,:) - & @@ -174,6 +177,7 @@ subroutine deriv_gf_6_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(9,6) * var(:,nj-8,:) ) * idel jr = nj - 6 end if + 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,:) - & @@ -236,6 +240,7 @@ subroutine deriv_gf_6_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(9,6) * var(:,:,nk-8) ) * idel kr = nk - 6 end if + 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_6_3_min_err_coeff.F90 b/src/Derivatives_6_3_min_err_coeff.F90 index dc8850c..b2d00e7 100644 --- a/src/Derivatives_6_3_min_err_coeff.F90 +++ b/src/Derivatives_6_3_min_err_coeff.F90 @@ -90,6 +90,8 @@ subroutine deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 3) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -147,6 +149,7 @@ subroutine deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) ir = ni - 6 end if + 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,:,:) - & @@ -212,6 +215,7 @@ subroutine deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) jr = nj - 6 end if + 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,:) - & @@ -278,6 +282,7 @@ subroutine deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) kr = nk - 6 end if + 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) - & @@ -446,6 +451,8 @@ subroutine up_deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva idel = 1.0_wp / delta + if (gsize < 3) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -624,6 +631,7 @@ subroutine up_deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva ir = ni - 6 end if + if (il > ir+1) call CCTK_WARN (0, "domain too small") where ( up(il:ir,:,:) < zero ) dvar(il:ir,:,:) = ( a1(-3) * var(il-3:ir-3,:,:) + & a1(-2) * var(il-2:ir-2,:,:) + & @@ -821,6 +829,7 @@ subroutine up_deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva jr = nj - 6 end if + if (jl > jr+1) call CCTK_WARN (0, "domain too small") where ( up(:,jl:jr,:) < zero ) dvar(:,jl:jr,:) = ( a1(-3) * var(:,jl-3:jr-3,:) + & a1(-2) * var(:,jl-2:jr-2,:) + & @@ -1019,6 +1028,7 @@ subroutine up_deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva kr = nk - 6 end if + if (kl > kr+1) call CCTK_WARN (0, "domain too small") where ( up(:,:,kl:kr) < zero ) dvar(:,:,kl:kr) = ( a1(-3) * var(:,:,kl-3:kr-3) + & a1(-2) * var(:,:,kl-2:kr-2) + & diff --git a/src/Derivatives_6_5.F90 b/src/Derivatives_6_5.F90 index 09e2ac4..1aaae62 100644 --- a/src/Derivatives_6_5.F90 +++ b/src/Derivatives_6_5.F90 @@ -104,6 +104,8 @@ subroutine deriv_gf_6_5 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 3) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -186,6 +188,7 @@ subroutine deriv_gf_6_5 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(6,1) * var(ni-5,:,:) ) * idel ir = ni - 7 end if + 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,:,:) - & @@ -276,6 +279,7 @@ subroutine deriv_gf_6_5 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(6,1) * var(:,nj-5,:) ) * idel jr = nj - 7 end if + 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,:) - & @@ -367,6 +371,7 @@ subroutine deriv_gf_6_5 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(6,1) * var(:,:,nk-5) ) * idel kr = nk - 7 end if + 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_6_5_min_err_coeff.F90 b/src/Derivatives_6_5_min_err_coeff.F90 index 0cb6ee7..f3735ab 100644 --- a/src/Derivatives_6_5_min_err_coeff.F90 +++ b/src/Derivatives_6_5_min_err_coeff.F90 @@ -106,6 +106,8 @@ subroutine deriv_gf_6_5_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) idel = 1.0_wp / delta + if (gsize < 3) call CCTK_WARN (0, "not enough ghostzones") + direction: select case (dir) case (0) direction if ( bb(1) == 0 ) then @@ -192,6 +194,7 @@ subroutine deriv_gf_6_5_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(7,1) * var(ni-6,:,:) ) * idel ir = ni - 7 end if + 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,:,:) - & @@ -286,6 +289,7 @@ subroutine deriv_gf_6_5_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(7,1) * var(:,nj-6,:) ) * idel jr = nj - 7 end if + 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,:) - & @@ -381,6 +385,7 @@ subroutine deriv_gf_6_5_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) q(7,1) * var(:,:,nk-6) ) * idel kr = nk - 7 end if + 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) - & -- cgit v1.2.3