diff options
Diffstat (limited to 'src/Derivatives_2_1.F90')
| -rw-r--r-- | src/Derivatives_2_1.F90 | 24 |
1 files changed, 24 insertions, 0 deletions
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") |