From 8be96036015dd3a5d220f8b27944f9c575d837fc Mon Sep 17 00:00:00 2001 From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr> Date: Thu, 21 Nov 2019 13:57:03 +0100 Subject: [PATCH] Philippe 21/11/2019: OpenACC: countjv: allow comparisons in mppdb_check --- src/MNH/tools.f90 | 83 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) diff --git a/src/MNH/tools.f90 b/src/MNH/tools.f90 index e1e2efa8f..16b39d680 100644 --- a/src/MNH/tools.f90 +++ b/src/MNH/tools.f90 @@ -107,6 +107,8 @@ end function Countjv3d #ifdef MNH_OPENACC subroutine Countjv1d_device(ltab, i1,ic) + use mode_mppdb, only: mppdb_initialized + logical, dimension(:), intent(in) :: ltab ! Mask integer, dimension(:), intent(out) :: i1 ! Positions of elements with 'true' value integer, intent(out) :: ic ! Total number of 'true' values @@ -116,6 +118,7 @@ subroutine Countjv1d_device(ltab, i1,ic) !$acc data present( ltab, i1 ) +if ( .not. mppdb_initialized ) then !$acc kernels !To allow comparisons... (i1 is not fully used) @@ -140,12 +143,34 @@ subroutine Countjv1d_device(ltab, i1,ic) end do !$acc end kernels +else + +!$acc kernels + +!To allow comparisons... (i1 is not fully used) + i1(:) = -999 + + ic = 0 + + do ji = 1, size( ltab, 1 ) + if ( ltab(ji ) ) then + ic = ic +1 + idx = ic + i1(idx) = ji + end if + end do +!$acc end kernels + +end if + !$acc end data end subroutine Countjv1d_device subroutine Countjv2d_device(ltab, i1, i2, ic) + use mode_mppdb, only: mppdb_initialized + logical, dimension(:,:), intent(in) :: ltab ! Mask integer, dimension(:), intent(out) :: i1, i2 ! Positions of elements with 'true' value integer, intent(out) :: ic ! Total number of 'true' values @@ -155,6 +180,7 @@ subroutine Countjv2d_device(ltab, i1, i2, ic) !$acc data present( ltab, i1, i2 ) +if ( .not. mppdb_initialized ) then !$acc kernels !To allow comparisons... (i1/i2 are not fully used) @@ -183,12 +209,38 @@ subroutine Countjv2d_device(ltab, i1, i2, ic) end do !$acc end kernels +else + +!$acc kernels + +!To allow comparisons... (i1/i2 are not fully used) + i1(:) = -999 + i2(:) = -999 + + ic = 0 + + do jj = 1, size( ltab, 2 ) + do ji = 1, size( ltab, 1 ) + if ( ltab(ji, jj ) ) then + ic = ic +1 + idx = ic + i1(idx) = ji + i2(idx) = jj + end if + end do + end do +!$acc end kernels + +end if + !$acc end data end subroutine Countjv2d_device subroutine Countjv3d_device(ltab, i1, i2, i3, ic) + use mode_mppdb, only: mppdb_initialized + logical, dimension(:,:,:), intent(in) :: ltab ! Mask integer, dimension(:), intent(out) :: i1, i2, i3 ! Positions of elements with 'true' value integer, intent(out) :: ic ! Total number of 'true' values @@ -198,6 +250,9 @@ subroutine Countjv3d_device(ltab, i1, i2, i3, ic) !$acc data present( ltab, i1, i2, i3 ) +if ( .not. mppdb_initialized ) then +!$acc kernels + !To allow comparisons... (i1/i2/i3 are not fully used) !Can be removed in production ! i1(:) = -999 @@ -228,6 +283,34 @@ subroutine Countjv3d_device(ltab, i1, i2, i3, ic) end do !$acc end kernels +else + +!$acc kernels + +!To allow comparisons... (i1/i2/i3 are not fully used) + i1(:) = -999 + i2(:) = -999 + i3(:) = -999 + + ic = 0 + + do jk = 1, size( ltab, 3 ) + do jj = 1, size( ltab, 2 ) + do ji = 1, size( ltab, 1 ) + if ( ltab(ji, jj, jk ) ) then + ic = ic +1 + idx = ic + i1(idx) = ji + i2(idx) = jj + i3(idx) = jk + end if + end do + end do + end do +!$acc end kernels + +end if + !$acc end data end subroutine Countjv3d_device -- GitLab