Juan 23/02/2022:tools.f90, convert to "modi" to avoid very long compilation...

Juan 23/02/2022:tools.f90, convert to "modi" to avoid very long compilation time when change only implementation

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