diff --git a/src/MNH/mode_openacc_set_device.f90 b/src/MNH/mode_openacc_set_device.f90
index bd440f9809d4c832c1ebac8b11ea6419e58cff7a..205667ebdec692737e1676f1ab1c7635f6e6a6b9 100644
--- a/src/MNH/mode_openacc_set_device.f90
+++ b/src/MNH/mode_openacc_set_device.f90
@@ -12,7 +12,7 @@ MODULE MODE_OPENACC_SET_DEVICE
   
   IMPLICIT NONE
 
-#ifndef _FAKEOPENACC  
+#if defined(MNH_OPENACC) && !defined(_FAKEOPENACC)   
   INTEGER(kind=acc_device_kind) :: mnh_idevice_type_at_init = -1000
   INTEGER(kind=acc_device_kind) :: mnh_idevice_type_current = -1
 #endif  
@@ -23,7 +23,7 @@ CONTAINS
   
   SUBROUTINE MNH_OPENACC_GET_DEVICE_AT_INIT()
 
-#ifndef _FAKEOPENACC     
+#if defined(MNH_OPENACC) && !defined(_FAKEOPENACC)      
     USE&
          openacc , ONLY : acc_get_device_type,acc_device_kind
     
@@ -44,7 +44,7 @@ CONTAINS
   
   SUBROUTINE MNH_OPENACC_GET_DEVICE()
 
-#ifndef _FAKEOPENACC    
+#if defined(MNH_OPENACC) && !defined(_FAKEOPENACC)    
     USE&
          openacc , ONLY : acc_get_device_type,acc_device_kind
     
@@ -63,7 +63,7 @@ CONTAINS
   
   SUBROUTINE MNH_OPENACC_SET_DEVICE_HOST()
 
-#ifndef _FAKEOPENACC    
+#if defined(MNH_OPENACC) && !defined(_FAKEOPENACC)    
     USE&
          openacc , ONLY : acc_set_device_type,acc_device_host,acc_get_device_type
     
@@ -80,7 +80,7 @@ CONTAINS
   
   SUBROUTINE MNH_OPENACC_SET_DEVICE_NVIDIA()
 
-#ifndef _FAKEOPENACC    
+#if defined(MNH_OPENACC) && !defined(_FAKEOPENACC)    
     USE&
          openacc , ONLY : acc_set_device_type,acc_device_nvidia,acc_get_device_type
     
@@ -96,7 +96,7 @@ CONTAINS
 
  SUBROUTINE MNH_OPENACC_SET_DEVICE_DEFAULT()
 
-#ifndef _FAKEOPENACC
+#if defined(MNH_OPENACC) && !defined(_FAKEOPENACC)
     USE&
          openacc , ONLY : acc_set_device_type,acc_device_nvidia,acc_get_device_type
     
diff --git a/src/MNH/tools.f90 b/src/MNH/tools.f90
index 41929a0c19623f4969a6fdef10de336db2affd08..25d6d76acb22d8d2201785ea864515e6105bb9b5 100644
--- a/src/MNH/tools.f90
+++ b/src/MNH/tools.f90
@@ -108,8 +108,11 @@ end function Countjv3d
 
 #ifdef MNH_OPENACC
 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
+#endif  
 
   logical, dimension(:), intent(in)  :: ltab ! Mask
   integer, dimension(:), intent(out) :: i1   ! Positions of elements with 'true' value
@@ -120,7 +123,11 @@ 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
+#else
+if (.not. mppdb_initialized ) then  
+#endif   
 
 ic = 0
    
@@ -172,9 +179,12 @@ 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
-
+#endif
+  
   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
@@ -184,8 +194,12 @@ 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
-
+#else
+if (.not. mppdb_initialized ) then  
+#endif
+   
 ic = 0   
      
 !$acc kernels
@@ -245,7 +259,10 @@ 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
+#endif   
 
   logical, dimension(:,:,:), intent(in)  :: ltab       ! Mask
   integer, dimension(:),     intent(out) :: i1, i2, i3 ! Positions of elements with 'true' value
@@ -256,7 +273,11 @@ 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
+#else
+if (.not. mppdb_initialized ) then  
+#endif   
 
 ic = 0