Add new parameters derivatives_zero_y and derivatives_zero_z in order to

ecplictly setting any derivatives in the y- and/or z-direction to zero
when simulating 1- or 2-D problems with a 3D code. This avoids issues with
errors at roundoff level in the y- and z-directions. Should be used with care
and together with the parameter check_grid_sizes to avoid complaints about
too small grids in the y- and z-directions.

Has only been tested in a few cases. If problems are caused by this commit,
please report them immediately.


git-svn-id: https://svn.cct.lsu.edu/repos/numrel/LSUThorns/SummationByParts/trunk@59 f69c4107-0314-4c4f-9ad4-17e986b73f4a

1 files changed, 298 insertions, 294 deletions

diff --git a/src/Dissipation_4_3_min_err_coeff_alt.F90 b/src/Dissipation_4_3_min_err_coeff_alt.F90
index 4f103cd..ef619d0 100644
--- a/src/Dissipation_4_3_min_err_coeff_alt.F90
+++ b/src/Dissipation_4_3_min_err_coeff_alt.F90
@@ -182,307 +182,311 @@ subroutine dissipation_4_3_alt (var, lsh, gsh, lbnd, bb, gsize, &
 
   deallocate ( a, d, b, h, tmp )
 
-  allocate ( a(nj,nj), d(nj,nj), b(nj,nj), h(nj,nj), tmp(nj,nj) )
-  a = zero; d = zero; b = zero; h = zero;
-
-  call set_bmatrix ( b, bb(3:4), lsh(2), gsh(2), lbnd(2), delta(2), dfl )
+  if ( zero_derivs_y == 0 ) then
+    allocate ( a(nj,nj), d(nj,nj), b(nj,nj), h(nj,nj), tmp(nj,nj) )
+    a = zero; d = zero; b = zero; h = zero;
   
-  call set_hmatrix ( h, bb(3:4) )
-
-  if ( any ( bb(3:4) == 0 ) ) then
-
-    call set_dmatrix ( d, bb(3:4) )
-
-    a = -transpose ( matmul ( h, matmul ( transpose(d), matmul ( b, d ) ) ) )
-
-  else
-
-    if ( lsh(2) /= gsh(2) ) then
-      call CCTK_WARN(0, 'Internal error. Bounding box inconsistent with grid' )
-    end if
-
-    center = gsh(2) / 2
-    jr = center + max(3,gsize(2))
-
-    call set_dmatrix_half ( d(1:jr,1:jr), 1 )
-
-    tmp(1:jr,1:jr) = -transpose ( &
-                        matmul ( h(1:jr,1:jr), &
-                                 matmul ( &
-                                   transpose ( d(1:jr,1:jr) ), &
-                                    matmul ( b(1:jr,1:jr), &
-                                             d(1:jr,1:jr) ) ) ) )
-
-    a(1:jr,1:center) = tmp(1:jr,1:center)
-
-    jl = center + 1 - max(3,gsize(2))
-    d = zero
-    call set_dmatrix_half ( d(jl:nj,jl:nj), 2 )
-    tmp(jl:nj,jl:nj) = -transpose ( &
-                          matmul ( h(jl:nj,jl:nj), &
+    call set_bmatrix ( b, bb(3:4), lsh(2), gsh(2), lbnd(2), delta(2), dfl )
+    
+    call set_hmatrix ( h, bb(3:4) )
+  
+    if ( any ( bb(3:4) == 0 ) ) then
+  
+      call set_dmatrix ( d, bb(3:4) )
+  
+      a = -transpose ( matmul ( h, matmul ( transpose(d), matmul ( b, d ) ) ) )
+  
+    else
+  
+      if ( lsh(2) /= gsh(2) ) then
+        call CCTK_WARN(0, 'Internal error. Bounding box inconsistent with grid' )
+      end if
+  
+      center = gsh(2) / 2
+      jr = center + max(3,gsize(2))
+  
+      call set_dmatrix_half ( d(1:jr,1:jr), 1 )
+  
+      tmp(1:jr,1:jr) = -transpose ( &
+                          matmul ( h(1:jr,1:jr), &
                                    matmul ( &
-                                     transpose ( d(jl:nj,jl:nj) ), &
-                                     matmul ( b(jl:nj,jl:nj), &
-                                              d(jl:nj,jl:nj) ) ) ) )
-
-    a(jl:nj,center+1:nj) = tmp(jl:nj,center+1:nj)
-
-  end if
-
-  idel = epsilon / ( 64 * delta(2) )
- 
-
-  if ( bb(3) == 0 ) then
-
-    jl = 1 + gsize(2)
-
-  else
-
-    rhs(:,1,:) = rhs(:,1,:) + &
-                 ( a(1,1) * var(:,1,:) + a(2,1) * var(:,2,:) + &
-                   a(3,1) * var(:,3,:) + a(4,1) * var(:,4,:) ) * idel
-    rhs(:,2,:) = rhs(:,2,:) + &
-                 ( a(1,2) * var(:,1,:) + a(2,2) * var(:,2,:) + &
-                   a(3,2) * var(:,3,:) + a(4,2) * var(:,4,:) + &
-                   a(5,2) * var(:,5,:) + a(6,2) * var(:,6,:) + &
-                   a(7,2) * var(:,7,:) + a(8,2) * var(:,8,:) ) * idel
-    rhs(:,3,:) = rhs(:,3,:) + &
-                 ( a(1,3) * var(:,1,:) + a(2,3) * var(:,2,:) + &
-                   a(3,3) * var(:,3,:) + a(4,3) * var(:,4,:) + &
-                   a(5,3) * var(:,5,:) + a(6,3) * var(:,6,:) + &
-                   a(7,3) * var(:,7,:) + a(8,3) * var(:,8,:) ) * idel
-    rhs(:,4,:) = rhs(:,4,:) + &
-                 ( a(1,4) * var(:,1,:) + a(2,4) * var(:,2,:) + &
-                   a(3,4) * var(:,3,:) + a(4,4) * var(:,4,:) + &
-                   a(5,4) * var(:,5,:) + a(6,4) * var(:,6,:) + &
-                   a(7,4) * var(:,7,:) + a(8,4) * var(:,8,:) ) * idel
-    rhs(:,5,:) = rhs(:,5,:) + &
-                 ( a(1,5) * var(:,1,:) + a(2,5) * var(:,2,:) + &
-                   a(3,5) * var(:,3,:) + a(4,5) * var(:,4,:) + &
-                   a(5,5) * var(:,5,:) + a(6,5) * var(:,6,:) + &
-                   a(7,5) * var(:,7,:) + a(8,5) * var(:,8,:) ) * idel
-
-    jl = 6
-
-  end if
-
-  if ( bb(4) == 0 ) then
-
-    jr = nj - gsize(2)
-
-  else
-
-    rhs(:,nj-4,:) = rhs(:,nj-4,:) + &
-                    ( a(nj-7,nj-4) * var(:,nj-7,:) + &
-                      a(nj-6,nj-4) * var(:,nj-6,:) + &
-                      a(nj-5,nj-4) * var(:,nj-5,:) + &
-                      a(nj-4,nj-4) * var(:,nj-4,:) + &
-                      a(nj-3,nj-4) * var(:,nj-3,:) + &
-                      a(nj-2,nj-4) * var(:,nj-2,:) + &
-                      a(nj-1,nj-4) * var(:,nj-1,:) + &
-                      a(nj,nj-4) * var(:,nj,:) ) * idel
-    rhs(:,nj-3,:) = rhs(:,nj-3,:) + &
-                    ( a(nj-7,nj-3) * var(:,nj-7,:) + &
-                      a(nj-6,nj-3) * var(:,nj-6,:) + &
-                      a(nj-5,nj-3) * var(:,nj-5,:) + &
-                      a(nj-4,nj-3) * var(:,nj-4,:) + &
-                      a(nj-3,nj-3) * var(:,nj-3,:) + &
-                      a(nj-2,nj-3) * var(:,nj-2,:) + &
-                      a(nj-1,nj-3) * var(:,nj-1,:) + &
-                      a(nj,nj-3) * var(:,nj,:) ) * idel
-    rhs(:,nj-2,:) = rhs(:,nj-2,:) + &
-                    ( a(nj-7,nj-2) * var(:,nj-7,:) + &
-                      a(nj-6,nj-2) * var(:,nj-6,:) + &
-                      a(nj-5,nj-2) * var(:,nj-5,:) + &
-                      a(nj-4,nj-2) * var(:,nj-4,:) + &
-                      a(nj-3,nj-2) * var(:,nj-3,:) + &
-                      a(nj-2,nj-2) * var(:,nj-2,:) + &
-                      a(nj-1,nj-2) * var(:,nj-1,:) + &
-                      a(nj,nj-2) * var(:,nj,:) ) * idel
-    rhs(:,nj-1,:) = rhs(:,nj-1,:) + &
-                    ( a(nj-7,nj-1) * var(:,nj-7,:) + &
-                      a(nj-6,nj-1) * var(:,nj-6,:) + &
-                      a(nj-5,nj-1) * var(:,nj-5,:) + &
-                      a(nj-4,nj-1) * var(:,nj-4,:) + &
-                      a(nj-3,nj-1) * var(:,nj-3,:) + &
-                      a(nj-2,nj-1) * var(:,nj-2,:) + &
-                      a(nj-1,nj-1) * var(:,nj-1,:) + &
-                      a(nj,nj-1) * var(:,nj,:) ) * idel
-    rhs(:,nj,:)   = rhs(:,nj,:) + &
-                    ( a(nj-3,nj) * var(:,nj-3,:) + &
-                      a(nj-2,nj) * var(:,nj-2,:) + &
-                      a(nj-1,nj) * var(:,nj-1,:) + &
-                      a(nj,nj) * var(:,nj,:) ) * idel
-
-    jr = nj - 5
-
-  end if
-
-  do j = jl, jr
-
-    rhs(:,j,:) = rhs(:,j,:) + &
-                   ( a(j-3,j) * var(:,j-3,:) + &
-                     a(j-2,j) * var(:,j-2,:) + &
-                     a(j-1,j) * var(:,j-1,:) + &
-                     a(j,j) * var(:,j,:) + &
-                     a(j+1,j) * var(:,j+1,:) + &
-                     a(j+2,j) * var(:,j+2,:) + &
-                     a(j+3,j) * var(:,j+3,:) ) * idel
-
-  end do
-
-  deallocate ( a, d, b, h, tmp )
-
-  allocate ( a(nk,nk), d(nk,nk), b(nk,nk), h(nk,nk), tmp(nk,nk) )
-  a = zero; d = zero; b = zero; h = zero; tmp = zero
-
-  call set_bmatrix ( b, bb(5:6), lsh(3), gsh(3), lbnd(3), delta(3), dfl )
-
-  call set_hmatrix ( h, bb(5:6) )
-
-  if ( any ( bb(5:6) == 0 ) ) then
-
-    call set_dmatrix ( d, bb(5:6) )
-
-    a = -transpose ( matmul ( h, matmul ( transpose(d), matmul ( b, d ) ) ) )
-
-  else
-
-    if ( lsh(3) /= gsh(3) ) then
-      call CCTK_WARN(0, 'Internal error. Bounding box inconsistent with grid' )
+                                     transpose ( d(1:jr,1:jr) ), &
+                                      matmul ( b(1:jr,1:jr), &
+                                               d(1:jr,1:jr) ) ) ) )
+  
+      a(1:jr,1:center) = tmp(1:jr,1:center)
+  
+      jl = center + 1 - max(3,gsize(2))
+      d = zero
+      call set_dmatrix_half ( d(jl:nj,jl:nj), 2 )
+      tmp(jl:nj,jl:nj) = -transpose ( &
+                            matmul ( h(jl:nj,jl:nj), &
+                                     matmul ( &
+                                       transpose ( d(jl:nj,jl:nj) ), &
+                                       matmul ( b(jl:nj,jl:nj), &
+                                                d(jl:nj,jl:nj) ) ) ) )
+  
+      a(jl:nj,center+1:nj) = tmp(jl:nj,center+1:nj)
+  
     end if
-
-    center = gsh(3) / 2
-    kr = center + max(3,gsize(3))
-
-    call set_dmatrix_half ( d(1:kr,1:kr), 1 )
-
-    tmp(1:kr,1:kr) = -transpose ( &
-                        matmul ( h(1:kr,1:kr), &
-                                 matmul ( &
-                                   transpose ( d(1:kr,1:kr) ), &
-                                    matmul ( b(1:kr,1:kr), &
-                                             d(1:kr,1:kr) ) ) ) )
-
-    a(1:kr,1:center) = tmp(1:kr,1:center)
-
-    kl = center + 1 - max(3,gsize(3))
-    d = zero
-    call set_dmatrix_half ( d(kl:nk,kl:nk), 2 )
-    tmp(kl:nk,kl:nk) = -transpose ( &
-                          matmul ( h(kl:nk,kl:nk), &
-                                   matmul ( &
-                                     transpose ( d(kl:nk,kl:nk) ), &
-                                     matmul ( b(kl:nk,kl:nk), &
-                                              d(kl:nk,kl:nk) ) ) ) )
-
-    a(kl:nk,center+1:nk) = tmp(kl:nk,center+1:nk)
-
-  end if
-
-  idel = epsilon / ( 64 * delta(3) )
-
-  if ( bb(5) == 0 ) then
-
-    kl = 1 + gsize(3)
-
-  else
-
-    rhs(:,:,1) = rhs(:,:,1) + &
-                 ( a(1,1) * var(:,:,1) + a(2,1) * var(:,:,2) + &
-                   a(3,1) * var(:,:,3) + a(4,1) * var(:,:,4) ) * idel
-    rhs(:,:,2) = rhs(:,:,2) + &
-                 ( a(1,2) * var(:,:,1) + a(2,2) * var(:,:,2) + &
-                   a(3,2) * var(:,:,3) + a(4,2) * var(:,:,4) + &
-                   a(5,2) * var(:,:,5) + a(6,2) * var(:,:,6) + &
-                   a(7,2) * var(:,:,7) + a(8,2) * var(:,:,8) ) * idel
-    rhs(:,:,3) = rhs(:,:,3) + &
-                 ( a(1,3) * var(:,:,1) + a(2,3) * var(:,:,2) + &
-                   a(3,3) * var(:,:,3) + a(4,3) * var(:,:,4) + &
-                   a(5,3) * var(:,:,5) + a(6,3) * var(:,:,6) + &
-                   a(7,3) * var(:,:,7) + a(8,3) * var(:,:,8) ) * idel
-    rhs(:,:,4) = rhs(:,:,4) + &
-                 ( a(1,4) * var(:,:,1) + a(2,4) * var(:,:,2) + &
-                   a(3,4) * var(:,:,3) + a(4,4) * var(:,:,4) + &
-                   a(5,4) * var(:,:,5) + a(6,4) * var(:,:,6) + &
-                   a(7,4) * var(:,:,7) + a(8,4) * var(:,:,8) ) * idel
-    rhs(:,:,5) = rhs(:,:,5) + &
-                 ( a(1,5) * var(:,:,1) + a(2,5) * var(:,:,2) + &
-                   a(3,5) * var(:,:,3) + a(4,5) * var(:,:,4) + &
-                   a(5,5) * var(:,:,5) + a(6,5) * var(:,:,6) + &
-                   a(7,5) * var(:,:,7) + a(8,5) * var(:,:,8) ) * idel
-
-    kl = 6
-
+  
+    idel = epsilon / ( 64 * delta(2) )
+   
+  
+    if ( bb(3) == 0 ) then
+  
+      jl = 1 + gsize(2)
+  
+    else
+  
+      rhs(:,1,:) = rhs(:,1,:) + &
+                   ( a(1,1) * var(:,1,:) + a(2,1) * var(:,2,:) + &
+                     a(3,1) * var(:,3,:) + a(4,1) * var(:,4,:) ) * idel
+      rhs(:,2,:) = rhs(:,2,:) + &
+                   ( a(1,2) * var(:,1,:) + a(2,2) * var(:,2,:) + &
+                     a(3,2) * var(:,3,:) + a(4,2) * var(:,4,:) + &
+                     a(5,2) * var(:,5,:) + a(6,2) * var(:,6,:) + &
+                     a(7,2) * var(:,7,:) + a(8,2) * var(:,8,:) ) * idel
+      rhs(:,3,:) = rhs(:,3,:) + &
+                   ( a(1,3) * var(:,1,:) + a(2,3) * var(:,2,:) + &
+                     a(3,3) * var(:,3,:) + a(4,3) * var(:,4,:) + &
+                     a(5,3) * var(:,5,:) + a(6,3) * var(:,6,:) + &
+                     a(7,3) * var(:,7,:) + a(8,3) * var(:,8,:) ) * idel
+      rhs(:,4,:) = rhs(:,4,:) + &
+                   ( a(1,4) * var(:,1,:) + a(2,4) * var(:,2,:) + &
+                     a(3,4) * var(:,3,:) + a(4,4) * var(:,4,:) + &
+                     a(5,4) * var(:,5,:) + a(6,4) * var(:,6,:) + &
+                     a(7,4) * var(:,7,:) + a(8,4) * var(:,8,:) ) * idel
+      rhs(:,5,:) = rhs(:,5,:) + &
+                   ( a(1,5) * var(:,1,:) + a(2,5) * var(:,2,:) + &
+                     a(3,5) * var(:,3,:) + a(4,5) * var(:,4,:) + &
+                     a(5,5) * var(:,5,:) + a(6,5) * var(:,6,:) + &
+                     a(7,5) * var(:,7,:) + a(8,5) * var(:,8,:) ) * idel
+  
+      jl = 6
+  
+    end if
+  
+    if ( bb(4) == 0 ) then
+  
+      jr = nj - gsize(2)
+  
+    else
+  
+      rhs(:,nj-4,:) = rhs(:,nj-4,:) + &
+                      ( a(nj-7,nj-4) * var(:,nj-7,:) + &
+                        a(nj-6,nj-4) * var(:,nj-6,:) + &
+                        a(nj-5,nj-4) * var(:,nj-5,:) + &
+                        a(nj-4,nj-4) * var(:,nj-4,:) + &
+                        a(nj-3,nj-4) * var(:,nj-3,:) + &
+                        a(nj-2,nj-4) * var(:,nj-2,:) + &
+                        a(nj-1,nj-4) * var(:,nj-1,:) + &
+                        a(nj,nj-4) * var(:,nj,:) ) * idel
+      rhs(:,nj-3,:) = rhs(:,nj-3,:) + &
+                      ( a(nj-7,nj-3) * var(:,nj-7,:) + &
+                        a(nj-6,nj-3) * var(:,nj-6,:) + &
+                        a(nj-5,nj-3) * var(:,nj-5,:) + &
+                        a(nj-4,nj-3) * var(:,nj-4,:) + &
+                        a(nj-3,nj-3) * var(:,nj-3,:) + &
+                        a(nj-2,nj-3) * var(:,nj-2,:) + &
+                        a(nj-1,nj-3) * var(:,nj-1,:) + &
+                        a(nj,nj-3) * var(:,nj,:) ) * idel
+      rhs(:,nj-2,:) = rhs(:,nj-2,:) + &
+                      ( a(nj-7,nj-2) * var(:,nj-7,:) + &
+                        a(nj-6,nj-2) * var(:,nj-6,:) + &
+                        a(nj-5,nj-2) * var(:,nj-5,:) + &
+                        a(nj-4,nj-2) * var(:,nj-4,:) + &
+                        a(nj-3,nj-2) * var(:,nj-3,:) + &
+                        a(nj-2,nj-2) * var(:,nj-2,:) + &
+                        a(nj-1,nj-2) * var(:,nj-1,:) + &
+                        a(nj,nj-2) * var(:,nj,:) ) * idel
+      rhs(:,nj-1,:) = rhs(:,nj-1,:) + &
+                      ( a(nj-7,nj-1) * var(:,nj-7,:) + &
+                        a(nj-6,nj-1) * var(:,nj-6,:) + &
+                        a(nj-5,nj-1) * var(:,nj-5,:) + &
+                        a(nj-4,nj-1) * var(:,nj-4,:) + &
+                        a(nj-3,nj-1) * var(:,nj-3,:) + &
+                        a(nj-2,nj-1) * var(:,nj-2,:) + &
+                        a(nj-1,nj-1) * var(:,nj-1,:) + &
+                        a(nj,nj-1) * var(:,nj,:) ) * idel
+      rhs(:,nj,:)   = rhs(:,nj,:) + &
+                      ( a(nj-3,nj) * var(:,nj-3,:) + &
+                        a(nj-2,nj) * var(:,nj-2,:) + &
+                        a(nj-1,nj) * var(:,nj-1,:) + &
+                        a(nj,nj) * var(:,nj,:) ) * idel
+  
+      jr = nj - 5
+  
+    end if
+  
+    do j = jl, jr
+  
+      rhs(:,j,:) = rhs(:,j,:) + &
+                     ( a(j-3,j) * var(:,j-3,:) + &
+                       a(j-2,j) * var(:,j-2,:) + &
+                       a(j-1,j) * var(:,j-1,:) + &
+                       a(j,j) * var(:,j,:) + &
+                       a(j+1,j) * var(:,j+1,:) + &
+                       a(j+2,j) * var(:,j+2,:) + &
+                       a(j+3,j) * var(:,j+3,:) ) * idel
+  
+    end do
+  
+    deallocate ( a, d, b, h, tmp )
   end if
 
-  if ( bb(6) == 0 ) then
-
-    kr = nk - gsize(3)
-
-  else
-
-    rhs(:,:,nk-4) = rhs(:,:,nk-4) + &
-                    ( a(nk-7,nk-4) * var(:,:,nk-7) + &
-                      a(nk-6,nk-4) * var(:,:,nk-6) + &
-                      a(nk-5,nk-4) * var(:,:,nk-5) + &
-                      a(nk-4,nk-4) * var(:,:,nk-4) + &
-                      a(nk-3,nk-4) * var(:,:,nk-3) + &
-                      a(nk-2,nk-4) * var(:,:,nk-2) + &
-                      a(nk-1,nk-4) * var(:,:,nk-1) + &
-                      a(nk,nk-4) * var(:,:,nk) ) * idel
-    rhs(:,:,nk-3) = rhs(:,:,nk-3) + &
-                    ( a(nk-7,nk-3) * var(:,:,nk-7) + &
-                      a(nk-6,nk-3) * var(:,:,nk-6) + &
-                      a(nk-5,nk-3) * var(:,:,nk-5) + &
-                      a(nk-4,nk-3) * var(:,:,nk-4) + &
-                      a(nk-3,nk-3) * var(:,:,nk-3) + &
-                      a(nk-2,nk-3) * var(:,:,nk-2) + &
-                      a(nk-1,nk-3) * var(:,:,nk-1) + &
-                      a(nk,nk-3) * var(:,:,nk) ) * idel
-    rhs(:,:,nk-2) = rhs(:,:,nk-2) + &
-                    ( a(nk-7,nk-2) * var(:,:,nk-7) + &
-                      a(nk-6,nk-2) * var(:,:,nk-6) + &
-                      a(nk-5,nk-2) * var(:,:,nk-5) + &
-                      a(nk-4,nk-2) * var(:,:,nk-4) + &
-                      a(nk-3,nk-2) * var(:,:,nk-3) + &
-                      a(nk-2,nk-2) * var(:,:,nk-2) + &
-                      a(nk-1,nk-2) * var(:,:,nk-1) + &
-                      a(nk,nk-2) * var(:,:,nk) ) * idel
-    rhs(:,:,nk-1) = rhs(:,:,nk-1) + &
-                    ( a(nk-7,nk-1) * var(:,:,nk-7) + &
-                      a(nk-6,nk-1) * var(:,:,nk-6) + &
-                      a(nk-5,nk-1) * var(:,:,nk-5) + &
-                      a(nk-4,nk-1) * var(:,:,nk-4) + &
-                      a(nk-3,nk-1) * var(:,:,nk-3) + &
-                      a(nk-2,nk-1) * var(:,:,nk-2) + &
-                      a(nk-1,nk-1) * var(:,:,nk-1) + &
-                      a(nk,nk-1) * var(:,:,nk) ) * idel
-    rhs(:,:,nk)   = rhs(:,:,nk) + &
-                    ( a(nk-3,nk) * var(:,:,nk-3) + &
-                      a(nk-2,nk) * var(:,:,nk-2) + &
-                      a(nk-1,nk) * var(:,:,nk-1) + &
-                      a(nk,nk) * var(:,:,nk) ) * idel
-
-    kr = nk - 5
-
+  if ( zero_derivs_z == 0 ) then
+    allocate ( a(nk,nk), d(nk,nk), b(nk,nk), h(nk,nk), tmp(nk,nk) )
+    a = zero; d = zero; b = zero; h = zero; tmp = zero
+  
+    call set_bmatrix ( b, bb(5:6), lsh(3), gsh(3), lbnd(3), delta(3), dfl )
+  
+    call set_hmatrix ( h, bb(5:6) )
+  
+    if ( any ( bb(5:6) == 0 ) ) then
+  
+      call set_dmatrix ( d, bb(5:6) )
+  
+      a = -transpose ( matmul ( h, matmul ( transpose(d), matmul ( b, d ) ) ) )
+  
+    else
+  
+      if ( lsh(3) /= gsh(3) ) then
+        call CCTK_WARN(0, 'Internal error. Bounding box inconsistent with grid' )
+      end if
+  
+      center = gsh(3) / 2
+      kr = center + max(3,gsize(3))
+  
+      call set_dmatrix_half ( d(1:kr,1:kr), 1 )
+  
+      tmp(1:kr,1:kr) = -transpose ( &
+                          matmul ( h(1:kr,1:kr), &
+                                   matmul ( &
+                                     transpose ( d(1:kr,1:kr) ), &
+                                      matmul ( b(1:kr,1:kr), &
+                                               d(1:kr,1:kr) ) ) ) )
+  
+      a(1:kr,1:center) = tmp(1:kr,1:center)
+  
+      kl = center + 1 - max(3,gsize(3))
+      d = zero
+      call set_dmatrix_half ( d(kl:nk,kl:nk), 2 )
+      tmp(kl:nk,kl:nk) = -transpose ( &
+                            matmul ( h(kl:nk,kl:nk), &
+                                     matmul ( &
+                                       transpose ( d(kl:nk,kl:nk) ), &
+                                       matmul ( b(kl:nk,kl:nk), &
+                                                d(kl:nk,kl:nk) ) ) ) )
+  
+      a(kl:nk,center+1:nk) = tmp(kl:nk,center+1:nk)
+  
+    end if
+  
+    idel = epsilon / ( 64 * delta(3) )
+  
+    if ( bb(5) == 0 ) then
+  
+      kl = 1 + gsize(3)
+  
+    else
+  
+      rhs(:,:,1) = rhs(:,:,1) + &
+                   ( a(1,1) * var(:,:,1) + a(2,1) * var(:,:,2) + &
+                     a(3,1) * var(:,:,3) + a(4,1) * var(:,:,4) ) * idel
+      rhs(:,:,2) = rhs(:,:,2) + &
+                   ( a(1,2) * var(:,:,1) + a(2,2) * var(:,:,2) + &
+                     a(3,2) * var(:,:,3) + a(4,2) * var(:,:,4) + &
+                     a(5,2) * var(:,:,5) + a(6,2) * var(:,:,6) + &
+                     a(7,2) * var(:,:,7) + a(8,2) * var(:,:,8) ) * idel
+      rhs(:,:,3) = rhs(:,:,3) + &
+                   ( a(1,3) * var(:,:,1) + a(2,3) * var(:,:,2) + &
+                     a(3,3) * var(:,:,3) + a(4,3) * var(:,:,4) + &
+                     a(5,3) * var(:,:,5) + a(6,3) * var(:,:,6) + &
+                     a(7,3) * var(:,:,7) + a(8,3) * var(:,:,8) ) * idel
+      rhs(:,:,4) = rhs(:,:,4) + &
+                   ( a(1,4) * var(:,:,1) + a(2,4) * var(:,:,2) + &
+                     a(3,4) * var(:,:,3) + a(4,4) * var(:,:,4) + &
+                     a(5,4) * var(:,:,5) + a(6,4) * var(:,:,6) + &
+                     a(7,4) * var(:,:,7) + a(8,4) * var(:,:,8) ) * idel
+      rhs(:,:,5) = rhs(:,:,5) + &
+                   ( a(1,5) * var(:,:,1) + a(2,5) * var(:,:,2) + &
+                     a(3,5) * var(:,:,3) + a(4,5) * var(:,:,4) + &
+                     a(5,5) * var(:,:,5) + a(6,5) * var(:,:,6) + &
+                     a(7,5) * var(:,:,7) + a(8,5) * var(:,:,8) ) * idel
+  
+      kl = 6
+  
+    end if
+  
+    if ( bb(6) == 0 ) then
+  
+      kr = nk - gsize(3)
+  
+    else
+  
+      rhs(:,:,nk-4) = rhs(:,:,nk-4) + &
+                      ( a(nk-7,nk-4) * var(:,:,nk-7) + &
+                        a(nk-6,nk-4) * var(:,:,nk-6) + &
+                        a(nk-5,nk-4) * var(:,:,nk-5) + &
+                        a(nk-4,nk-4) * var(:,:,nk-4) + &
+                        a(nk-3,nk-4) * var(:,:,nk-3) + &
+                        a(nk-2,nk-4) * var(:,:,nk-2) + &
+                        a(nk-1,nk-4) * var(:,:,nk-1) + &
+                        a(nk,nk-4) * var(:,:,nk) ) * idel
+      rhs(:,:,nk-3) = rhs(:,:,nk-3) + &
+                      ( a(nk-7,nk-3) * var(:,:,nk-7) + &
+                        a(nk-6,nk-3) * var(:,:,nk-6) + &
+                        a(nk-5,nk-3) * var(:,:,nk-5) + &
+                        a(nk-4,nk-3) * var(:,:,nk-4) + &
+                        a(nk-3,nk-3) * var(:,:,nk-3) + &
+                        a(nk-2,nk-3) * var(:,:,nk-2) + &
+                        a(nk-1,nk-3) * var(:,:,nk-1) + &
+                        a(nk,nk-3) * var(:,:,nk) ) * idel
+      rhs(:,:,nk-2) = rhs(:,:,nk-2) + &
+                      ( a(nk-7,nk-2) * var(:,:,nk-7) + &
+                        a(nk-6,nk-2) * var(:,:,nk-6) + &
+                        a(nk-5,nk-2) * var(:,:,nk-5) + &
+                        a(nk-4,nk-2) * var(:,:,nk-4) + &
+                        a(nk-3,nk-2) * var(:,:,nk-3) + &
+                        a(nk-2,nk-2) * var(:,:,nk-2) + &
+                        a(nk-1,nk-2) * var(:,:,nk-1) + &
+                        a(nk,nk-2) * var(:,:,nk) ) * idel
+      rhs(:,:,nk-1) = rhs(:,:,nk-1) + &
+                      ( a(nk-7,nk-1) * var(:,:,nk-7) + &
+                        a(nk-6,nk-1) * var(:,:,nk-6) + &
+                        a(nk-5,nk-1) * var(:,:,nk-5) + &
+                        a(nk-4,nk-1) * var(:,:,nk-4) + &
+                        a(nk-3,nk-1) * var(:,:,nk-3) + &
+                        a(nk-2,nk-1) * var(:,:,nk-2) + &
+                        a(nk-1,nk-1) * var(:,:,nk-1) + &
+                        a(nk,nk-1) * var(:,:,nk) ) * idel
+      rhs(:,:,nk)   = rhs(:,:,nk) + &
+                      ( a(nk-3,nk) * var(:,:,nk-3) + &
+                        a(nk-2,nk) * var(:,:,nk-2) + &
+                        a(nk-1,nk) * var(:,:,nk-1) + &
+                        a(nk,nk) * var(:,:,nk) ) * idel
+  
+      kr = nk - 5
+  
+    end if
+  
+    do k = kl, kr
+  
+      rhs(:,:,k) = rhs(:,:,k) + &
+                     ( a(k-3,k) * var(:,:,k-3) + &
+                       a(k-2,k) * var(:,:,k-2) + &
+                       a(k-1,k) * var(:,:,k-1) + &
+                       a(k,k) * var(:,:,k) + &
+                       a(k+1,k) * var(:,:,k+1) + &
+                       a(k+2,k) * var(:,:,k+2) + &
+                       a(k+3,k) * var(:,:,k+3) ) * idel
+  
+    end do
+  
+    deallocate ( a, d, b, h, tmp )
   end if
 
-  do k = kl, kr
-
-    rhs(:,:,k) = rhs(:,:,k) + &
-                   ( a(k-3,k) * var(:,:,k-3) + &
-                     a(k-2,k) * var(:,:,k-2) + &
-                     a(k-1,k) * var(:,:,k-1) + &
-                     a(k,k) * var(:,:,k) + &
-                     a(k+1,k) * var(:,:,k+1) + &
-                     a(k+2,k) * var(:,:,k+2) + &
-                     a(k+3,k) * var(:,:,k+3) ) * idel
-
-  end do
-
-  deallocate ( a, d, b, h, tmp )
-
 contains
 
   subroutine set_dmatrix ( d, bb )