From da2a60d82ab4b52ee5e909d593dedf7426411824 Mon Sep 17 00:00:00 2001
From: schnetter <schnetter@f69c4107-0314-4c4f-9ad4-17e986b73f4a>
Date: Thu, 17 Apr 2008 04:46:53 +0000
Subject: Add OpenMP workshare constructs

git-svn-id: https://svn.cct.lsu.edu/repos/numrel/LSUThorns/SummationByParts/trunk@101 f69c4107-0314-4c4f-9ad4-17e986b73f4a
---
 src/Derivatives_2_1.F90               | 24 ++++++++++++++++++++++++
 src/Derivatives_4_3.F90               | 18 ++++++++++++++++++
 src/Derivatives_4_3_min_err_coeff.F90 | 16 ++++++++++++++++
 src/Dissipation_4_2.F90               | 18 ++++++++++++++++++
 4 files changed, 76 insertions(+)

diff --git a/src/Derivatives_2_1.F90 b/src/Derivatives_2_1.F90
index 62a12a5..489fc1d 100644
--- a/src/Derivatives_2_1.F90
+++ b/src/Derivatives_2_1.F90
@@ -41,17 +41,21 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
     if ( bb(1) == 0 ) then
       il = 1 + gsize
     else
+!$omp parallel workshare
       dvar(1,:,:) = ( q(1,1) * var(1,:,:) + q(2,1) * var(2,:,:) ) * idel
       dvar(2,:,:) = ( q(1,2) * var(1,:,:) + q(3,2) * var(3,:,:) ) * idel
+!$omp end parallel workshare
       il = 3
     end if
     if ( bb(2) == 0 ) then
       ir = ni - gsize
     else
+!$omp parallel workshare
       dvar(ni-1,:,:) = - ( q(1,2) * var(ni,:,:) + &
                            q(3,2) * var(ni-2,:,:) ) * idel
       dvar(ni,:,:) = - ( q(1,1) * var(ni,:,:) + &
                          q(2,1) * var(ni-1,:,:) ) * idel
+!$omp end parallel workshare
       ir = ni - 2
     end if
     if (il > ir+1) call CCTK_WARN (0, "domain too small")
@@ -65,17 +69,21 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
       if ( bb(1) == 0 ) then
         jl = 1 + gsize
       else
+!$omp parallel workshare
         dvar(:,1,:) = ( q(1,1) * var(:,1,:) + q(2,1) * var(:,2,:) ) * idel
         dvar(:,2,:) = ( q(1,2) * var(:,1,:) + q(3,2) * var(:,3,:) ) * idel
+!$omp end parallel workshare
         jl = 3
       end if
       if ( bb(2) == 0 ) then
         jr = nj - gsize
       else
+!$omp parallel workshare
         dvar(:,nj-1,:) = - ( q(1,2) * var(:,nj,:) + &
                              q(3,2) * var(:,nj-2,:) ) * idel
         dvar(:,nj,:) = - ( q(1,1) * var(:,nj,:) + &
                            q(2,1) * var(:,nj-1,:) ) * idel
+!$omp end parallel workshare
         jr = nj - 2
       end if
       if (jl > jr+1) call CCTK_WARN (0, "domain too small")
@@ -91,17 +99,21 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
       if ( bb(1) == 0 ) then
         kl = 1 + gsize
       else
+!$omp parallel workshare
         dvar(:,:,1) = ( q(1,1) * var(:,:,1) + q(2,1) * var(:,:,2) ) * idel
         dvar(:,:,2) = ( q(1,2) * var(:,:,1) + q(3,2) * var(:,:,3) ) * idel
+!$omp end parallel workshare
         kl = 3
       end if
       if ( bb(2) == 0 ) then
         kr = nk - gsize
       else 
+!$omp parallel workshare
         dvar(:,:,nk-1) = - ( q(1,2) * var(:,:,nk) + &
                              q(3,2) * var(:,:,nk-2) ) * idel
         dvar(:,:,nk) = - ( q(1,1) * var(:,:,nk) + &
                            q(2,1) * var(:,:,nk-1) ) * idel
+!$omp end parallel workshare
         kr = nk - 2
       end if
       if (kl > kr+1) call CCTK_WARN (0, "domain too small")
@@ -153,6 +165,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
     if ( bb(1) == 0 ) then
       il = 1 + gsize
     else
+!$omp parallel workshare
       where ( up(1,:,:) < zero )
         dvar(1,:,:) = ( q1(1,1) * var(1,:,:) + q1(2,1) * var(2,:,:) ) * idel
       elsewhere
@@ -165,11 +178,13 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
         dvar(2,:,:) = ( q2(1,2) * var(1,:,:) + q2(2,2) * var(2,:,:) + &
                         q2(3,2) * var(3,:,:) ) * idel
       end where
+!$omp end parallel workshare
       il = 3
     end if
     if ( bb(2) == 0 ) then
       ir = ni - gsize
     else
+!$omp parallel workshare
       where ( up(ni-1,:,:) < zero )
         dvar(ni-1,:,:) = - ( q2(1,2) * var(ni,:,:) + &
                              q2(2,2) * var(ni-1,:,:) + &
@@ -186,6 +201,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
         dvar(ni,:,:) = - ( q1(1,1) * var(ni,:,:) + &
                            q1(2,1) * var(ni-1,:,:) ) * idel
       end where
+!$omp end parallel workshare
       ir = ni - 2
     end if
     if (il > ir+1) call CCTK_WARN (0, "domain too small")
@@ -207,6 +223,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
       if ( bb(1) == 0 ) then
         jl = 1 + gsize
       else
+!$omp parallel workshare
         where ( up(:,1,:) < zero )
           dvar(:,1,:) = ( q1(1,1) * var(:,1,:) + q1(2,1) * var(:,2,:) ) * idel
         elsewhere
@@ -219,11 +236,13 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
           dvar(:,2,:) = ( q2(1,2) * var(:,1,:) + q2(2,2) * var(:,2,:) + &
                           q2(3,2) * var(:,3,:) ) * idel
         end where
+!$omp end parallel workshare
         jl = 3
       end if
       if ( bb(2) == 0 ) then
         jr = nj - gsize
       else
+!$omp parallel workshare
         where ( up(:,nj-1,:) < zero )
           dvar(:,nj-1,:) = - ( q2(1,2) * var(:,nj,:) + &
                                q2(2,2) * var(:,nj-1,:) + &
@@ -240,6 +259,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
           dvar(:,nj,:) = - ( q1(1,1) * var(:,nj,:) + &
                              q1(2,1) * var(:,nj-1,:) ) * idel
         end where
+!$omp end parallel workshare
         jr = nj - 2
       end if
       if (jl > jr+1) call CCTK_WARN (0, "domain too small")
@@ -262,6 +282,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
       if ( bb(1) == 0 ) then
         kl = 1 + gsize
       else
+!$omp parallel workshare
         where ( up(:,:,1) < zero )
           dvar(:,:,1) = ( q1(1,1) * var(:,:,1) + q1(2,1) * var(:,:,2) ) * idel
         elsewhere
@@ -274,11 +295,13 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
           dvar(:,:,2) = ( q2(1,2) * var(:,:,1) + q2(2,2) * var(:,:,2) + &
                           q2(3,2) * var(:,:,3) ) * idel
         end where
+!$omp end parallel workshare
         kl = 3
       end if
       if ( bb(2) == 0 ) then
         kr = nk - gsize
       else 
+!$omp parallel workshare
         where ( up(:,:,nk-1) < zero )
           dvar(:,:,nk-1) = - ( q2(1,2) * var(:,:,nk) + &
                                q2(2,2) * var(:,:,nk-1) + &
@@ -295,6 +318,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar )
           dvar(:,:,nk) = - ( q1(1,1) * var(:,:,nk) + &
                              q1(2,1) * var(:,:,nk-1) ) * idel
         end where
+!$omp end parallel workshare
         kr = nk - 2
       end if
       if (kl > kr+1) call CCTK_WARN (0, "domain too small")
diff --git a/src/Derivatives_4_3.F90 b/src/Derivatives_4_3.F90
index 19a012e..1bc9734 100644
--- a/src/Derivatives_4_3.F90
+++ b/src/Derivatives_4_3.F90
@@ -41,6 +41,7 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
     if ( bb(1) == 0 ) then
       il = 1 + gsize
     else
+!$omp parallel workshare
       dvar(1,:,:) = ( q(1,1) * var(1,:,:) + q(2,1) * var(2,:,:) + &
                       q(3,1) * var(3,:,:) + q(4,1) * var(4,:,:) ) * idel
       dvar(2,:,:) = ( q(1,2) * var(1,:,:) + q(2,2) * var(2,:,:) + &
@@ -57,11 +58,13 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
                       q(3,5) * var(3,:,:) + q(4,5) * var(4,:,:) + &
                       q(5,5) * var(5,:,:) + q(6,5) * var(6,:,:) + &
                       q(7,5) * var(7,:,:) ) * idel
+!$omp end parallel workshare
       il = 6
     end if
     if ( bb(2) == 0 ) then
       ir = ni - gsize
     else
+!$omp parallel workshare
       dvar(ni-4,:,:) = - ( q(1,5) * var(ni,:,:) + q(2,5) * var(ni-1,:,:) + &
                            q(3,5) * var(ni-2,:,:) + q(4,5) * var(ni-3,:,:) + &
                            q(5,5) * var(ni-4,:,:) + q(6,5) * var(ni-5,:,:) + &
@@ -81,13 +84,16 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
       dvar(ni,:,:)   = - ( q(1,1) * var(ni,:,:) + q(2,1) * var(ni-1,:,:) + &
                            q(3,1) * var(ni-2,:,:) + &
                            q(4,1) * var(ni-3,:,:) ) * idel
+!$omp end parallel workshare
       ir = ni - 5
     end if
     if (il > ir+1) call CCTK_WARN (0, "domain too small")
+!$omp parallel workshare
     dvar(il:ir,:,:) = ( a(1) * ( var(il+1:ir+1,:,:) - &
                                  var(il-1:ir-1,:,:) ) + &
                         a(2) * ( var(il+2:ir+2,:,:) - &
                                  var(il-2:ir-2,:,:) ) ) * idel
+!$omp end parallel workshare
   case (1) direction
     if ( zero_derivs_y /= 0 ) then
       dvar = zero
@@ -95,6 +101,7 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
       if ( bb(1) == 0 ) then
         jl = 1 + gsize
       else
+!$omp parallel workshare
         dvar(:,1,:) = ( q(1,1) * var(:,1,:) + q(2,1) * var(:,2,:) + &
                         q(3,1) * var(:,3,:) + q(4,1) * var(:,4,:) ) * idel
         dvar(:,2,:) = ( q(1,2) * var(:,1,:) + q(2,2) * var(:,2,:) + &
@@ -111,11 +118,13 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
                         q(3,5) * var(:,3,:) + q(4,5) * var(:,4,:) + &
                         q(5,5) * var(:,5,:) + q(6,5) * var(:,6,:) + &
                         q(7,5) * var(:,7,:) ) * idel
+!$omp end parallel workshare
         jl = 6
       end if
       if ( bb(2) == 0 ) then
         jr = nj - gsize
       else
+!$omp parallel workshare
         dvar(:,nj-4,:) = - ( q(1,5) * var(:,nj,:) + q(2,5) * var(:,nj-1,:) + &
                              q(3,5) * var(:,nj-2,:) + q(4,5) * var(:,nj-3,:) + &
                              q(5,5) * var(:,nj-4,:) + q(6,5) * var(:,nj-5,:) + &
@@ -135,13 +144,16 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
         dvar(:,nj,:)   = - ( q(1,1) * var(:,nj,:) + q(2,1) * var(:,nj-1,:) + &
                              q(3,1) * var(:,nj-2,:) + &
                              q(4,1) * var(:,nj-3,:) ) * idel
+!$omp end parallel workshare
         jr = nj - 5
       end if
       if (jl > jr+1) call CCTK_WARN (0, "domain too small")
+!$omp parallel workshare
       dvar(:,jl:jr,:) = ( a(1) * ( var(:,jl+1:jr+1,:) - &
                                    var(:,jl-1:jr-1,:) ) + &
                           a(2) * ( var(:,jl+2:jr+2,:) - &
                                    var(:,jl-2:jr-2,:) ) ) * idel
+!$omp end parallel workshare
     end if
   case (2) direction
     if ( zero_derivs_z /= 0 ) then
@@ -150,6 +162,7 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
       if ( bb(1) == 0 ) then
         kl = 1 + gsize
       else
+!$omp parallel workshare
         dvar(:,:,1) = ( q(1,1) * var(:,:,1) + q(2,1) * var(:,:,2) + &
                         q(3,1) * var(:,:,3) + q(4,1) * var(:,:,4) ) * idel
         dvar(:,:,2) = ( q(1,2) * var(:,:,1) + q(2,2) * var(:,:,2) + &
@@ -166,11 +179,13 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
                         q(3,5) * var(:,:,3) + q(4,5) * var(:,:,4) + &
                         q(5,5) * var(:,:,5) + q(6,5) * var(:,:,6) + &
                         q(7,5) * var(:,:,7) ) * idel
+!$omp end parallel workshare
         kl = 6
       end if
       if ( bb(2) == 0 ) then
         kr = nk - gsize
       else 
+!$omp parallel workshare
         dvar(:,:,nk-4) = - ( q(1,5) * var(:,:,nk) + q(2,5) * var(:,:,nk-1) + &
                              q(3,5) * var(:,:,nk-2) + q(4,5) * var(:,:,nk-3) + &
                              q(5,5) * var(:,:,nk-4) + q(6,5) * var(:,:,nk-5) + &
@@ -190,13 +205,16 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
         dvar(:,:,nk)   = - ( q(1,1) * var(:,:,nk) + q(2,1) * var(:,:,nk-1) + &
                              q(3,1) * var(:,:,nk-2) + &
                              q(4,1) * var(:,:,nk-3) ) * idel
+!$omp end parallel workshare
         kr = nk - 5
       end if
       if (kl > kr+1) call CCTK_WARN (0, "domain too small")
+!$omp parallel workshare
       dvar(:,:,kl:kr) = ( a(1) * ( var(:,:,kl+1:kr+1) - &
                                    var(:,:,kl-1:kr-1) ) + &
                           a(2) * ( var(:,:,kl+2:kr+2) - &
                                    var(:,:,kl-2:kr-2) ) ) * idel
+!$omp end parallel workshare
     end if
   end select direction
 end subroutine deriv_gf_4_3
diff --git a/src/Derivatives_4_3_min_err_coeff.F90 b/src/Derivatives_4_3_min_err_coeff.F90
index 7bc0a82..c5968ef 100644
--- a/src/Derivatives_4_3_min_err_coeff.F90
+++ b/src/Derivatives_4_3_min_err_coeff.F90
@@ -41,6 +41,7 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
     if ( bb(1) == 0 ) then
       il = 1 + gsize
     else
+!$omp parallel workshare
       dvar(1,:,:) = ( q(1,1) * var(1,:,:) + q(2,1) * var(2,:,:) + &
                       q(3,1) * var(3,:,:) + q(4,1) * var(4,:,:) + &
                       q(5,1) * var(5,:,:) ) * idel
@@ -60,11 +61,13 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
                       q(3,5) * var(3,:,:) + q(4,5) * var(4,:,:) + &
                       q(5,5) * var(5,:,:) + q(6,5) * var(6,:,:) + &
                       q(7,5) * var(7,:,:) ) * idel
+!$omp end parallel workshare
       il = 6
     end if
     if ( bb(2) == 0 ) then
       ir = ni - gsize
     else
+!$omp parallel workshare
       dvar(ni-4,:,:) = - ( q(1,5) * var(ni,:,:) + q(2,5) * var(ni-1,:,:) + &
                            q(3,5) * var(ni-2,:,:) + q(4,5) * var(ni-3,:,:) + &
                            q(5,5) * var(ni-4,:,:) + q(6,5) * var(ni-5,:,:) + &
@@ -84,13 +87,16 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
       dvar(ni,:,:)   = - ( q(1,1) * var(ni,:,:) + q(2,1) * var(ni-1,:,:) + &
                            q(3,1) * var(ni-2,:,:) + q(4,1) * var(ni-3,:,:) + &
                            q(5,1) * var(ni-4,:,:) ) * idel
+!$omp end parallel workshare
       ir = ni - 5
     end if
     if (il > ir+1) call CCTK_WARN (0, "domain too small")
+!$omp parallel workshare
     dvar(il:ir,:,:) = ( a(1) * ( var(il+1:ir+1,:,:) - &
                                  var(il-1:ir-1,:,:) ) + &
                         a(2) * ( var(il+2:ir+2,:,:) - &
                                  var(il-2:ir-2,:,:) ) ) * idel
+!$omp end parallel workshare
   case (1) direction
     if ( zero_derivs_y /= 0 ) then
       dvar = zero
@@ -98,6 +104,7 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
       if ( bb(1) == 0 ) then
         jl = 1 + gsize
       else
+!$omp parallel workshare
         dvar(:,1,:) = ( q(1,1) * var(:,1,:) + q(2,1) * var(:,2,:) + &
                         q(3,1) * var(:,3,:) + q(4,1) * var(:,4,:) + &
                         q(5,1) * var(:,5,:) ) * idel
@@ -117,11 +124,13 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
                         q(3,5) * var(:,3,:) + q(4,5) * var(:,4,:) + &
                         q(5,5) * var(:,5,:) + q(6,5) * var(:,6,:) + &
                         q(7,5) * var(:,7,:) ) * idel
+!$omp end parallel workshare
         jl = 6
       end if
       if ( bb(2) == 0 ) then
         jr = nj - gsize
       else
+!$omp parallel workshare
         dvar(:,nj-4,:) = - ( q(1,5) * var(:,nj,:) + q(2,5) * var(:,nj-1,:) + &
                              q(3,5) * var(:,nj-2,:) + q(4,5) * var(:,nj-3,:) + &
                              q(5,5) * var(:,nj-4,:) + q(6,5) * var(:,nj-5,:) + &
@@ -141,6 +150,7 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
         dvar(:,nj,:)   = - ( q(1,1) * var(:,nj,:) + q(2,1) * var(:,nj-1,:) + &
                              q(3,1) * var(:,nj-2,:) + q(4,1) * var(:,nj-3,:) + &
                              q(5,1) * var(:,nj-4,:) ) * idel
+!$omp end parallel workshare
         jr = nj - 5
       end if
       if (jl > jr+1) call CCTK_WARN (0, "domain too small")
@@ -156,6 +166,7 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
       if ( bb(1) == 0 ) then
         kl = 1 + gsize
       else
+!$omp parallel workshare
         dvar(:,:,1) = ( q(1,1) * var(:,:,1) + q(2,1) * var(:,:,2) + &
                         q(3,1) * var(:,:,3) + q(4,1) * var(:,:,4) + &
                         q(5,1) * var(:,:,5) ) * idel
@@ -175,11 +186,13 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
                         q(3,5) * var(:,:,3) + q(4,5) * var(:,:,4) + &
                         q(5,5) * var(:,:,5) + q(6,5) * var(:,:,6) + &
                         q(7,5) * var(:,:,7) ) * idel
+!$omp end parallel workshare
         kl = 6
       end if
       if ( bb(2) == 0 ) then
         kr = nk - gsize
       else 
+!$omp parallel workshare
         dvar(:,:,nk-4) = - ( q(1,5) * var(:,:,nk) + q(2,5) * var(:,:,nk-1) + &
                              q(3,5) * var(:,:,nk-2) + q(4,5) * var(:,:,nk-3) + &
                              q(5,5) * var(:,:,nk-4) + q(6,5) * var(:,:,nk-5) + &
@@ -199,13 +212,16 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar )
         dvar(:,:,nk)   = - ( q(1,1) * var(:,:,nk) + q(2,1) * var(:,:,nk-1) + &
                              q(3,1) * var(:,:,nk-2) + q(4,1) * var(:,:,nk-3) + &
                              q(5,1) * var(:,:,nk-4) ) * idel
+!$omp end parallel workshare
         kr = nk - 5
       end if
       if (kl > kr+1) call CCTK_WARN (0, "domain too small")
+!$omp parallel workshare
       dvar(:,:,kl:kr) = ( a(1) * ( var(:,:,kl+1:kr+1) - &
                                    var(:,:,kl-1:kr-1) ) + &
                           a(2) * ( var(:,:,kl+2:kr+2) - &
                                    var(:,:,kl-2:kr-2) ) ) * idel
+!$omp end parallel workshare
     end if
   end select direction
 end subroutine deriv_gf_4_3_opt
diff --git a/src/Dissipation_4_2.F90 b/src/Dissipation_4_2.F90
index 5b419c9..84746e7 100644
--- a/src/Dissipation_4_2.F90
+++ b/src/Dissipation_4_2.F90
@@ -35,6 +35,7 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
   if ( bb(1) == 0 ) then
     il = 1 + gsize(1)
   else
+!$omp parallel workshare
     rhs(1,:,:) = rhs(1,:,:) + &
                  ( a(1,1) * var(1,:,:) + a(2,1) * var(2,:,:) + &
                    a(3,1) * var(3,:,:) ) * idel
@@ -49,12 +50,14 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
                  ( 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,:,:) ) * idel
+!$omp end parallel workshare
 
     il = 5
   end if
   if ( bb(2) == 0 ) then
     ir = ni - gsize(1)
   else
+!$omp parallel workshare
     rhs(ni-3,:,:) = rhs(ni-3,:,:) + &
                  ( a(2,4) * var(ni-1,:,:) + a(3,4) * var(ni-2,:,:) + &
                    a(4,4) * var(ni-3,:,:) + a(5,4) * var(ni-4,:,:) + &
@@ -69,15 +72,18 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
     rhs(ni,:,:)   = rhs(ni,:,:) + &
                  ( a(1,1) * var(ni,:,:) + a(2,1) * var(ni-1,:,:) + &
                    a(3,1) * var(ni-2,:,:) ) * idel
+!$omp end parallel workshare
 
     ir = ni - 4
   end if
+!$omp parallel workshare
   rhs(il:ir,:,:) = rhs(il:ir,:,:) + &
                    ( -6.0_wp * var(il:ir,:,:) + &
                       4.0_wp * ( var(il-1:ir-1,:,:) + &
                                  var(il+1:ir+1,:,:) ) - &
                                ( var(il-2:ir-2,:,:) + &
                                  var(il+2:ir+2,:,:) ) ) * idel
+!$omp end parallel workshare
 
   if ( zero_derivs_y == 0 ) then
     call set_coeff ( a )
@@ -91,6 +97,7 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
     if ( bb(3) == 0 ) then
       jl = 1 + gsize(2)
     else
+!$omp parallel workshare
       rhs(:,1,:) = rhs(:,1,:) + &
                    ( a(1,1) * var(:,1,:) + a(2,1) * var(:,2,:) + &
                      a(3,1) * var(:,3,:) ) * idel
@@ -105,12 +112,14 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
                    ( 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,:) ) * idel
+!$omp end parallel workshare
   
       jl = 5
     end if
     if ( bb(4) == 0 ) then
       jr = nj - gsize(2)
     else
+!$omp parallel workshare
       rhs(:,nj-3,:) = rhs(:,nj-3,:) + &
                    ( a(2,4) * var(:,nj-1,:) + a(3,4) * var(:,nj-2,:) + &
                      a(4,4) * var(:,nj-3,:) + a(5,4) * var(:,nj-4,:) + &
@@ -125,15 +134,18 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
       rhs(:,nj,:)   = rhs(:,nj,:) + &
                    ( a(1,1) * var(:,nj,:) + a(2,1) * var(:,nj-1,:) + &
                      a(3,1) * var(:,nj-2,:) ) * idel
+!$omp end parallel workshare
   
       jr = nj - 4
     end if
+!$omp parallel workshare
     rhs(:,jl:jr,:) = rhs(:,jl:jr,:) + &
                      ( -6.0_wp * var(:,jl:jr,:) + &
                         4.0_wp * ( var(:,jl-1:jr-1,:) + &
                                    var(:,jl+1:jr+1,:) ) - &
                                  ( var(:,jl-2:jr-2,:) + &
                                    var(:,jl+2:jr+2,:) ) ) * idel
+!$omp end parallel workshare
   end if
 
   if ( zero_derivs_z == 0 ) then
@@ -148,6 +160,7 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
     if ( bb(5) == 0 ) then
       kl = 1 + gsize(3)
     else
+!$omp parallel workshare
       rhs(:,:,1) = rhs(:,:,1) + &
                    ( a(1,1) * var(:,:,1) + a(2,1) * var(:,:,2) + &
                      a(3,1) * var(:,:,3) ) * idel
@@ -162,12 +175,14 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
                    ( 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) ) * idel
+!$omp end parallel workshare
   
       kl = 5
     end if
     if ( bb(6) == 0 ) then
       kr = nk - gsize(3)
     else
+!$omp parallel workshare
       rhs(:,:,nk-3) = rhs(:,:,nk-3) + &
                    ( a(2,4) * var(:,:,nk-1) + a(3,4) * var(:,:,nk-2) + &
                      a(4,4) * var(:,:,nk-3) + a(5,4) * var(:,:,nk-4) + &
@@ -182,15 +197,18 @@ subroutine dissipation_4_2 (var, ni, nj, nk, bb, gsize, delta, epsilon, rhs)
       rhs(:,:,nk)   = rhs(:,:,nk) + &
                    ( a(1,1) * var(:,:,nk) + a(2,1) * var(:,:,nk-1) + &
                      a(3,1) * var(:,:,nk-2) ) * idel
+!$omp end parallel workshare
   
       kr = nk - 4
     end if
+!$omp parallel workshare
     rhs(:,:,kl:kr) = rhs(:,:,kl:kr) + &
                      ( -6.0_wp * var(:,:,kl:kr) + &
                         4.0_wp * ( var(:,:,kl-1:kr-1) + &
                                    var(:,:,kl+1:kr+1) ) - &
                                  ( var(:,:,kl-2:kr-2) + &
                                    var(:,:,kl+2:kr+2) ) ) * idel
+!$omp end parallel workshare
   end if
 
 contains
-- 
cgit v1.2.3