diff --git a/src/MNH/tools.f90 b/src/MNH/tools.f90
index f6beea8f1436eff18de787cca8a1abb072097bf4..939db6cd461bf03d5860d148ac8b1b9762a3cb83 100644
--- a/src/MNH/tools.f90
+++ b/src/MNH/tools.f90
@@ -3,7 +3,13 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-
+module modi_tools
+ ! /!\ converte this module MODE -> in MODI + subroutines/functions outside module
+ ! /!\ to avoid very long compilation time if implementation change in subroutines
+ ! /!\ This 'empty' module is here to avoid 'automatic' generation of wrong interface modi_quisort + modi_upcase
+ ! /!\ in futur version rename all 'use mode_tools' -> 'use modi_tools'
+ ! /!\ and change the module name below mode_tools -> modi_tools
+end module modi_tools
!################
module mode_tools
!################
@@ -28,23 +34,64 @@ implicit none
private
-public :: Countjv
public :: Quicksort
+interface
+ recursive subroutine Quicksort( ka, kbeg, kend, kpos )
+ integer, dimension(:), intent(inout) :: ka
+ integer, intent(in) :: kbeg, kend
+ integer, dimension(:), optional, intent(inout) :: kpos
+ end subroutine Quicksort
+end interface
+
public :: Upcase
+interface
+ function Upcase(hstring)
+ character(len=*), intent(in) :: hstring
+ character(len=len(hstring)) :: upcase
+ end function Upcase
+end interface
+public :: Countjv
interface Countjv
- module procedure Countjv1d, Countjv2d, Countjv3d
-end interface
+ function Countjv1d(ltab,i1) result(ic)
+ logical, dimension(:), intent(in) :: ltab ! Mask
+ integer, dimension(:), intent(out) :: i1 ! Positions of elements with 'true' value
+ integer :: ic ! Total number of 'true' values
+ end function Countjv1d
+ function Countjv2d(ltab,i1,i2) result(ic)
+ logical, dimension(:,:), intent(in) :: ltab ! Mask
+ integer, dimension(:), intent(out) :: i1, i2 ! Positions of elements with 'true' value
+ integer :: ic ! Total number of 'true' values
+ end function Countjv2d
+ function Countjv3d(ltab,i1,i2,i3) result(ic)
+ logical, dimension(:,:,:), intent(in) :: ltab ! Mask
+ integer, dimension(:), intent(out) :: i1, i2, i3 ! Positions of elements with 'true' value
+ integer :: ic ! Total number of 'true' values
+ end function Countjv3d
+end interface Countjv
#ifdef MNH_OPENACC
public :: Countjv_device
-
interface Countjv_device
- module procedure Countjv1d_device, Countjv2d_device, Countjv3d_device
+ subroutine Countjv1d_device(ltab, i1,ic)
+ 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
+ end subroutine Countjv1d_device
+ subroutine Countjv2d_device(ltab, i1, i2, ic)
+ 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
+ end subroutine Countjv2d_device
+ subroutine Countjv3d_device(ltab, i1, i2, i3, ic)
+ 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
+ end subroutine Countjv3d_device
end interface
#endif
-contains
+end module mode_tools
function Countjv1d(ltab,i1) result(ic)
logical, dimension(:), intent(in) :: ltab ! Mask
@@ -63,7 +110,6 @@ function Countjv1d(ltab,i1) result(ic)
end do
end function Countjv1d
-
function Countjv2d(ltab,i1,i2) result(ic)
logical, dimension(:,:), intent(in) :: ltab ! Mask
integer, dimension(:), intent(out) :: i1, i2 ! Positions of elements with 'true' value
@@ -84,7 +130,6 @@ function Countjv2d(ltab,i1,i2) result(ic)
end do
end function Countjv2d
-
function Countjv3d(ltab,i1,i2,i3) result(ic)
logical, dimension(:,:,:), intent(in) :: ltab ! Mask
integer, dimension(:), intent(out) :: i1, i2, i3 ! Positions of elements with 'true' value
@@ -113,7 +158,7 @@ subroutine Countjv1d_device(ltab, i1,ic)
use mode_mppdb, only: mppdb_initialized
#ifndef _FAKEOPENACC
- use MODE_OPENACC_SET_DEVICE, only : mnh_idevice_type_current, acc_device_nvidia
+ use MODE_OPENACC_SET_DEVICE, only : mnh_idevice_type_current, acc_device_nvidia, acc_device_host
#endif
logical, dimension(:), intent(in) :: ltab ! Mask
@@ -126,7 +171,7 @@ subroutine Countjv1d_device(ltab, i1,ic)
!$acc data present( ltab, i1 )
#ifndef _FAKEOPENACC
-if ( (.not. mppdb_initialized ) .and. (mnh_idevice_type_current .eq. acc_device_nvidia ) ) then
+if ( (.not. mppdb_initialized ) .and. (mnh_idevice_type_current .ne. acc_device_host ) ) then
#else
if (.not. mppdb_initialized ) then
#endif
@@ -179,12 +224,11 @@ end if
end subroutine Countjv1d_device
-
subroutine Countjv2d_device(ltab, i1, i2, ic)
use mode_mppdb, only: mppdb_initialized
#ifndef _FAKEOPENACC
- use MODE_OPENACC_SET_DEVICE, only : mnh_idevice_type_current, acc_device_nvidia
+ use MODE_OPENACC_SET_DEVICE, only : mnh_idevice_type_current, acc_device_nvidia, acc_device_host
#endif
logical, dimension(:,:), intent(in) :: ltab ! Mask
@@ -197,7 +241,7 @@ subroutine Countjv2d_device(ltab, i1, i2, ic)
!$acc data present( ltab, i1, i2 )
#ifndef _FAKEOPENACC
-if ( (.not. mppdb_initialized ) .and. (mnh_idevice_type_current .eq. acc_device_nvidia ) ) then
+if ( (.not. mppdb_initialized ) .and. (mnh_idevice_type_current .ne. acc_device_host ) ) then
#else
if (.not. mppdb_initialized ) then
#endif
@@ -258,11 +302,10 @@ end if
end subroutine Countjv2d_device
-
subroutine Countjv3d_device(ltab, i1, i2, i3, ic)
use mode_mppdb, only: mppdb_initialized
#ifndef _FAKEOPENACC
- use MODE_OPENACC_SET_DEVICE, only : mnh_idevice_type_current, acc_device_nvidia
+ use MODE_OPENACC_SET_DEVICE, only : mnh_idevice_type_current, acc_device_nvidia, acc_device_host
#endif
logical, dimension(:,:,:), intent(in) :: ltab ! Mask
@@ -275,7 +318,7 @@ subroutine Countjv3d_device(ltab, i1, i2, i3, ic)
!$acc data present( ltab, i1, i2, i3 )
#ifndef _FAKEOPENACC
-if ( (.not. mppdb_initialized ) .and. (mnh_idevice_type_current .eq. acc_device_nvidia ) ) then
+if ( (.not. mppdb_initialized ) .and. (mnh_idevice_type_current .ne. acc_device_host ) ) then
#else
if (.not. mppdb_initialized ) then
#endif
@@ -295,9 +338,10 @@ ic = 0
!Comment the following line + atomic directives to have consistent values for debugging
!Warning: huge impact on performance
!$acc loop collapse(3) private(idx) independent
- do jk = 1, size( ltab, 3 )
- do jj = 1, size( ltab, 2 )
- do ji = 1, size( ltab, 1 )
+!!$ do jk = 1, size( ltab, 3 )
+!!$ do jj = 1, size( ltab, 2 )
+!!$ do ji = 1, size( ltab, 1 )
+ do concurrent ( ji=1:size(ltab,1) , jj=1:size(ltab,2) , jk=1:size(ltab,3 ) )
if ( ltab(ji, jj, jk ) ) then
!$acc atomic capture
ic = ic +1
@@ -308,8 +352,8 @@ ic = 0
i3(idx) = jk
end if
end do
- end do
- end do
+!!$ end do
+!!$ end do
!$acc end kernels
else
@@ -382,7 +426,6 @@ recursive subroutine Quicksort( ka, kbeg, kend, kpos )
if ( jj + 1 < kend ) call Quicksort( ka, jj + 1, kend, kpos )
end subroutine Quicksort
-
function Upcase(hstring)
character(len=*), intent(in) :: hstring
character(len=len(hstring)) :: upcase
@@ -400,4 +443,4 @@ function Upcase(hstring)
end do
end function Upcase
-end module mode_tools
+!!$end module mode_tools