diff --git a/src/MNH/advec_4th_order_aux.f90 b/src/MNH/advec_4th_order_aux.f90
index 97ea2d96735aca54bf44318f9650776e126a4a8a..041ac45177d492ee723bffc082f27c942348466b 100644
--- a/src/MNH/advec_4th_order_aux.f90
+++ b/src/MNH/advec_4th_order_aux.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2005-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -110,6 +110,9 @@ USE MODD_CONF
USE MODE_DEVICE
#endif
use mode_ll, only: GET_INDICE_ll, LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_OPENACC
use mode_msg
@@ -140,8 +143,13 @@ INTEGER:: ILUOUT,IRESP ! for prints
! JUAN ACC
LOGICAL :: GWEST , GEAST
LOGICAL :: GSOUTH , GNORTH
+#ifndef MNH_OPENACC
REAL, DIMENSION(:,:), ALLOCATABLE :: ZHALO2_WEST, ZHALO2_EAST
REAL, DIMENSION(:,:), ALLOCATABLE :: ZHALO2_SOUTH, ZHALO2_NORTH
+#else
+REAL, DIMENSION(:,:), pointer, contiguous :: ZHALO2_WEST, ZHALO2_EAST
+REAL, DIMENSION(:,:), pointer, contiguous :: ZHALO2_SOUTH, ZHALO2_NORTH
+#endif
!
!$acc data present( PMEANX, PMEANY, PFIELDT )
@@ -151,12 +159,22 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PFIELDT,"ADVEC_4TH_ORDER_ALGO beg:PFIELDT")
END IF
+#ifndef MNH_OPENACC
allocate( zhalo2_west ( size( pfieldt, 2 ), size( pfieldt, 3 ) ) )
allocate( zhalo2_east ( size( pfieldt, 2 ), size( pfieldt, 3 ) ) )
allocate( zhalo2_south( size( pfieldt, 2 ), size( pfieldt, 3 ) ) )
allocate( zhalo2_north( size( pfieldt, 2 ), size( pfieldt, 3 ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ADVEC_4TH_ORDER_ALGO' )
+
+CALL MNH_MEM_GET( zhalo2_west, size( pfieldt, 2 ), size( pfieldt, 3 ) )
+CALL MNH_MEM_GET( zhalo2_east, size( pfieldt, 2 ), size( pfieldt, 3 ) )
+CALL MNH_MEM_GET( zhalo2_south, size( pfieldt, 2 ), size( pfieldt, 3 ) )
+CALL MNH_MEM_GET( zhalo2_north, size( pfieldt, 2 ), size( pfieldt, 3 ) )
-!$acc data create ( zhalo2_west, zhalo2_east, zhalo2_south, zhalo2_north )
+!$acc data present ( zhalo2_west, zhalo2_east, zhalo2_south, zhalo2_north )
+#endif
!-------------------------------------------------------------------------------
!
@@ -457,6 +475,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ADVEC_4TH_ORDER_ALGO' )
+#endif
+
!$acc end data
!-------------------------------------------------------------------------------
diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90
index 36ea18b0a8b986f52e92652df46d8c75c217fb8a..0af0a1c426abc1a24dd3edab8a111a9280cbc1f3 100644
--- a/src/MNH/advection_uvw.f90
+++ b/src/MNH/advection_uvw.f90
@@ -443,7 +443,10 @@ DO CONCURRENT (JI=1:IIU , JJ=1:IJU , JK=1:IKU )
PRVS(JI,JJ,JK) = PRVS(JI,JJ,JK) + ZRVS_ADV(JI,JJ,JK) / ISPLIT
PRWS(JI,JJ,JK) = PRWS(JI,JJ,JK) + ZRWS_ADV(JI,JJ,JK) / ISPLIT
END DO
+!$acc end kernels
+
IF (JSPL<ISPLIT) THEN
+!$acc kernels
!
! Guesses for next time splitting loop
!
@@ -459,8 +462,8 @@ DO CONCURRENT (JI=1:IIU , JJ=1:IJU , JK=1:IKU )
ZW(JI,JJ,JK) = ZW(JI,JJ,JK) + ZTSTEP / ZMZM_RHODJ(JI,JJ,JK) * &
(ZRWS_OTHER(JI,JJ,JK) + ZRWS_ADV(JI,JJ,JK))
END DO
-END IF
!$acc end kernels
+ END IF
!
! Top and bottom Boundaries
!
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
index b16d803f2dcec83542b3b6078c02a78443cd3ee8..b6102eb35422295e84c7d985d0cfdfda1f2af0e5 100644
--- a/src/MNH/advection_uvw_cen.f90
+++ b/src/MNH/advection_uvw_cen.f90
@@ -104,6 +104,7 @@ use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
#ifdef MNH_OPENACC
USE MODE_DEVICE
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
use mode_msg
#endif
use mode_mppdb
@@ -144,6 +145,8 @@ TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
!* 0.2 declarations of local variables
!
!
+INTEGER :: IIU, IJU, IKU
+#ifndef MNH_OPENACC
REAL, DIMENSION(:,:,:), allocatable :: ZUS
REAL, DIMENSION(:,:,:), allocatable :: ZVS
REAL, DIMENSION(:,:,:), allocatable :: ZWS
@@ -173,6 +176,37 @@ REAL, DIMENSION(:,:,:), allocatable :: ZRWCT
REAL, DIMENSION(:,:,:), allocatable :: ZMXM_RHODJ
REAL, DIMENSION(:,:,:), allocatable :: ZMYM_RHODJ
REAL, DIMENSION(:,:,:), allocatable :: ZMZM_RHODJ
+#else
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZUS
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZVS
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZWS
+ ! guess of cartesian components of
+ ! momentum at future (+PTSTEP) timestep
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRUS
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRVS
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRWS
+ ! cartesian components of
+ ! rhodJ times the tendency of
+ ! momentum from previous (-PTSTEP)
+ ! to future (+PTSTEP) timestep
+!
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRUT
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRVT
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRWT
+ ! cartesian
+ ! components of
+ ! momentum
+!
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRUCT
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRVCT
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZRWCT
+ ! contravariant
+ ! components
+ ! of momentum
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZMXM_RHODJ
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZMYM_RHODJ
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZMZM_RHODJ
+#endif
!
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
@@ -207,24 +241,49 @@ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus(:, :,
if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
-allocate( zus ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zvs ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zws ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zrus ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zrvs ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zrws ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zrut ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zrvt ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zrwt ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zruct ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zrvct ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zrwct ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zmxm_rhodj ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zmym_rhodj ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
-allocate( zmzm_rhodj ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
+IIU = SIZE( put, 1 )
+IJU = SIZE( put, 2 )
+IKU = SIZE( put, 3 )
+
+#ifndef MNH_OPENACC
+allocate( zus ( iiu, iju, iku ) )
+allocate( zvs ( iiu, iju, iku ) )
+allocate( zws ( iiu, iju, iku ) )
+allocate( zrus ( iiu, iju, iku ) )
+allocate( zrvs ( iiu, iju, iku ) )
+allocate( zrws ( iiu, iju, iku ) )
+allocate( zrut ( iiu, iju, iku ) )
+allocate( zrvt ( iiu, iju, iku ) )
+allocate( zrwt ( iiu, iju, iku ) )
+allocate( zruct ( iiu, iju, iku ) )
+allocate( zrvct ( iiu, iju, iku ) )
+allocate( zrwct ( iiu, iju, iku ) )
+allocate( zmxm_rhodj ( iiu, iju, iku ) )
+allocate( zmym_rhodj ( iiu, iju, iku ) )
+allocate( zmzm_rhodj ( iiu, iju, iku ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ADVECTION_UVW_CEN' )
+
+CALL MNH_MEM_GET( zus, iiu, iju, iku )
+CALL MNH_MEM_GET( zvs, iiu, iju, iku )
+CALL MNH_MEM_GET( zws, iiu, iju, iku )
+CALL MNH_MEM_GET( zrus, iiu, iju, iku )
+CALL MNH_MEM_GET( zrvs, iiu, iju, iku )
+CALL MNH_MEM_GET( zrws, iiu, iju, iku )
+CALL MNH_MEM_GET( zrut, iiu, iju, iku )
+CALL MNH_MEM_GET( zrvt, iiu, iju, iku )
+CALL MNH_MEM_GET( zrwt, iiu, iju, iku )
+CALL MNH_MEM_GET( zruct, iiu, iju, iku )
+CALL MNH_MEM_GET( zrvct, iiu, iju, iku )
+CALL MNH_MEM_GET( zrwct, iiu, iju, iku )
+CALL MNH_MEM_GET( zmxm_rhodj, iiu, iju, iku )
+CALL MNH_MEM_GET( zmym_rhodj, iiu, iju, iku )
+CALL MNH_MEM_GET( zmzm_rhodj, iiu, iju, iku )
-!$acc data create( zus, zvs, zws, zrus, zrvs, zrws, zrut, zrvt, zrwt, &
-!$acc & zruct, zrvct, zrwct, zmxm_rhodj, zmym_rhodj, zmzm_rhodj )
+!$acc data present( zus, zvs, zws, zrus, zrvs, zrws, zrut, zrvt, zrwt, &
+!$acc & zruct, zrvct, zrwct, zmxm_rhodj, zmym_rhodj, zmzm_rhodj )
+#endif
#ifdef MNH_OPENACC
CALL INIT_ON_HOST_AND_DEVICE(ZUS,-1e99,'ADVECTION_UVW_CEN::ZUS')
@@ -321,7 +380,7 @@ ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
!
END IF
!
-!$acc kernels
+!$acc kernels present( ZRUS, ZRVS, ZRWS, ZMXM_RHODJ, ZMYM_RHODJ, ZMZM_RHODJ )
ZUS(:,:,:) = ZRUS(:,:,:)/ZMXM_RHODJ(:,:,:)*2.*PTSTEP
ZVS(:,:,:) = ZRVS(:,:,:)/ZMYM_RHODJ(:,:,:)*2.*PTSTEP
ZWS(:,:,:) = ZRWS(:,:,:)/ZMZM_RHODJ(:,:,:)*2.*PTSTEP
@@ -352,6 +411,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ADVECTION_UVW_CEN' )
+#endif
+
!$acc end data
!-------------------------------------------------------------------------------
diff --git a/src/MNH/bl89.f90 b/src/MNH/bl89.f90
index e34f0524c01349592c51d663f4e18221a7f61418..18031de86aac25cb9a5f69cd4feb8ada6122249d 100644
--- a/src/MNH/bl89.f90
+++ b/src/MNH/bl89.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -82,6 +82,9 @@ USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_PARAMETERS
use modd_precision, only: MNHREAL
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_BITREP
@@ -115,6 +118,7 @@ INTEGER :: IKB,IKE
INTEGER :: IKT ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+#ifndef MNH_OPENACC
real, dimension(:,:), allocatable :: ZVPT ! Virtual Potential Temp at half levels
real, dimension(:,:), allocatable :: ZDELTVPT
! Increment of Virtual Potential Temp between two following levels
@@ -133,14 +137,35 @@ real, dimension(:,:), allocatable :: ZZZ,ZDZZ, &
real, dimension(:,:,:), allocatable :: ZRM
! ! input array packed according one horizontal coord.
real, dimension(:,:), allocatable :: ZSUM ! to replace SUM function
+#else
+real, dimension(:,:), pointer, contiguous :: ZVPT ! Virtual Potential Temp at half levels
+real, dimension(:,:), pointer, contiguous :: ZDELTVPT
+ ! Increment of Virtual Potential Temp between two following levels
+real, dimension(:,:), pointer, contiguous :: ZHLVPT
+ ! Virtual Potential Temp at half levels
+real, dimension(:), pointer, contiguous :: ZLWORK,ZINTE
+! ! downwards then upwards vertical displacement,
+! ! residual internal energy,
+! ! residual potential energy
+real, dimension(:,:), pointer, contiguous :: ZZZ,ZDZZ, &
+ ZG_O_THVREF, &
+ ZTHM,ZTKEM,ZLM, &
+ ZLMDN,ZSHEAR, &
+ ZSQRT_TKE
+! ! input and output arrays packed according one horizontal coord.
+real, dimension(:,:,:), pointer, contiguous :: ZRM
+! ! input array packed according one horizontal coord.
+real, dimension(:,:), pointer, contiguous :: ZSUM ! to replace SUM function
+#endif
!
-INTEGER :: IIU,IJU
+INTEGER :: IIU, IJU
INTEGER :: J1D ! horizontal loop counter
INTEGER :: JK,JKK,J3RD ! loop counters
INTEGER :: JRR ! moist loop counter
#ifdef MNH_OPENACC
integer :: ji, jj
#endif
+LOGICAL :: LAROME
REAL :: ZRVORD ! Rv/Rd
REAL :: ZPOTE,ZLWORK1,ZLWORK2
REAL :: ZTEST,ZTEST0,ZTESTM ! test for vectorization
@@ -160,32 +185,63 @@ if ( mppdb_initialized ) then
call Mppdb_check( pshear, "Bl89 beg:pshear" )
end if
-allocate( zvpt (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) )
-allocate( zdeltvpt (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) )
-allocate( zhlvpt (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) )
-allocate( zlwork (size( ptkem, 1 ) * size( ptkem, 2 ) ) )
-allocate( zinte (size( ptkem, 1 ) * size( ptkem, 2 ) ) )
-allocate( zzz (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) , &
- zdzz (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) , &
- zg_o_thvref(size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) , &
- zthm (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) , &
- ztkem (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) , &
- zlm (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) , &
- zlmdn (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) , &
- zshear (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) , &
- zsqrt_tke (size( ptkem, 1 ) * size( ptkem, 2 ), size( ptkem, 3 ) ) )
+IF ( CPROGRAM == 'AROME' ) THEN
+ LAROME = .TRUE.
+ELSE
+ LAROME = .FALSE.
+END IF
+
+IIU = SIZE( PTKEM, 1 )
+IJU = SIZE( PTKEM, 2 )
+IKT = SIZE( PTKEM, 3 )
+
+#ifndef MNH_OPENACC
+allocate( zvpt (IIU * IJU, IKT ) )
+allocate( zdeltvpt (IIU * IJU, IKT ) )
+allocate( zhlvpt (IIU * IJU, IKT ) )
+allocate( zlwork (IIU * IJU ) )
+allocate( zinte (IIU * IJU ) )
+allocate( zzz (IIU * IJU, IKT ) , &
+ zdzz (IIU * IJU, IKT ) , &
+ zg_o_thvref(IIU * IJU, IKT ) , &
+ zthm (IIU * IJU, IKT ) , &
+ ztkem (IIU * IJU, IKT ) , &
+ zlm (IIU * IJU, IKT ) , &
+ zlmdn (IIU * IJU, IKT ) , &
+ zshear (IIU * IJU, IKT ) , &
+ zsqrt_tke (IIU * IJU, IKT ) )
allocate( zrm (size( prm, 1 ) * size( prm, 2 ), size( prm, 3 ), size( prm, 4 ) ) )
if ( krr > 0 ) &
allocate( zsum (size( prm, 1 ) * size( prm, 2 ), size( prm, 3 ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( zvpt, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zdeltvpt, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zhlvpt, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zlwork, IIU * IJU )
+CALL MNH_MEM_GET( zinte, IIU * IJU )
+CALL MNH_MEM_GET( zzz, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zdzz, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zg_o_thvref, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zthm, IIU * IJU, IKT )
+CALL MNH_MEM_GET( ztkem, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zlm, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zlmdn, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zshear, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zsqrt_tke, IIU * IJU, IKT )
+CALL MNH_MEM_GET( zrm, size( prm, 1 ) * size( prm, 2 ), size( prm, 3 ), size( prm, 4 ) )
+if ( krr > 0 ) &
+ CALL MNH_MEM_GET( zsum, size( prm, 1 ) * size( prm, 2 ), size( prm, 3 ) )
-!$acc data create ( zvpt, zdeltvpt, zhlvpt, zlwork, zinte, &
-!$acc & zzz, zdzz, zg_o_thvref, zthm, ztkem, zlm, zlmdn, &
-!$acc & zshear, zsqrt_tke, zrm, zsum )
+!$acc data present ( zvpt, zdeltvpt, zhlvpt, zlwork, zinte, &
+!$acc & zzz, zdzz, zg_o_thvref, zthm, ztkem, zlm, zlmdn, &
+!$acc & zshear, zsqrt_tke, zrm, zsum )
+#endif
!$acc kernels
Z2SQRT2=2.*SQRT(2.)
-IIU=SIZE(PTKEM,1)
-IJU=SIZE(PTKEM,2)
!
IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
@@ -200,7 +256,8 @@ ZRVORD = XRV / XRD
!* 1. pack the horizontal dimensions into one
! ---------------------------------------
!
-IF (CPROGRAM=='AROME ') THEN
+IF ( LAROME ) THEN
+!$acc loop independent
DO JK=1,IKT
ZZZ (:,JK) = PZZ (:,1,JK)
ZDZZ (:,JK) = PDZZ (:,1,JK)
@@ -208,6 +265,7 @@ IF (CPROGRAM=='AROME ') THEN
ZTKEM (:,JK) = PTKEM (:,1,JK)
ZG_O_THVREF(:,JK) = XG/PTHVREF(:,1,JK)
END DO
+!$acc loop independent collapse(2)
DO JK=1,IKT
DO JRR=1,KRR
ZRM (:,JK,JRR) = PRM (:,1,JK,JRR)
@@ -260,25 +318,35 @@ ZSQRT_TKE = SQRT(ZTKEM)
!ZBL89EXP is defined here because (and not in ini_cturb) because XCED is defined in read_exseg (depending on BL89/RM17)
ZBL89EXP = LOG(16.)/(4.*LOG(XKARMAN)+LOG(XCED)-3.*LOG(XCMFS))
#else
-zsqrt_tke(:, : ) = Br_pow( ztkem, 0.5 )
+#ifdef MNH_COMPILER_NVHPC
+!$acc loop independent collapse(2)
+#endif
+do concurrent( ji = 1 : iiu, jj = 1 : iju )
+ zsqrt_tke(ji, jj) = Br_pow( ztkem(ji,jj), 0.5 )
+end do
!ZBL89EXP is defined here because (and not in ini_cturb) because XCED is defined in read_exseg (depending on BL89/RM17)
ZBL89EXP = Br_log( 16. ) / ( 4. * Br_log( XKARMAN )+ Br_log( XCED ) - 3. * Br_log( XCMFS) )
#endif
ZUSRBL89 = 1./ZBL89EXP
+!$acc end kernels
!-------------------------------------------------------------------------------
!
!* 2. Virtual potential temperature on the model grid
! -----------------------------------------------
!
IF( KRR > 0 ) THEN
+!$acc kernels
ZSUM(:,:) = 0.
DO JRR=1,KRR
ZSUM(:,:) = ZSUM(:,:)+ZRM(:,:,JRR)
ENDDO
- ZVPT(:,1:)=ZTHM(:,:) * ( 1. + ZRVORD*ZRM(:,:,1) ) &
+ ZVPT(:,:)=ZTHM(:,:) * ( 1. + ZRVORD*ZRM(:,:,1) ) &
/ ( 1. + ZSUM(:,:) )
+!$acc end kernels
ELSE
- ZVPT(:,1:)=ZTHM(:,:)
+!$acc kernels
+ ZVPT(:,:)=ZTHM(:,:)
+!$acc end kernels
END IF
!
!!!!!!!!!!!!
@@ -292,6 +360,7 @@ END IF
!but algorithm must remain the same.
!!!!!!!!!!!!
+!$acc kernels
ZDELTVPT(:,IKTB:IKTE)=ZVPT(:,IKTB:IKTE)-ZVPT(:,IKTB-KKL:IKTE-KKL)
ZDELTVPT(:,KKU)=ZVPT(:,KKU)-ZVPT(:,KKU-KKL)
ZDELTVPT(:,KKA)=0.
@@ -460,8 +529,7 @@ DO JK=IKTB,IKTE
#endif
END DO
-ZLM(:,JK)=MAX(ZLM(:,JK),XLINI)
-
+ ZLM(:,JK)=MAX(ZLM(:,JK),XLINI)
!
!
!* 8. end of the loop on the vertical levels
@@ -483,7 +551,7 @@ ZLM(:,KKU)=ZLM(:,IKE-KKL)
!* 10. retrieve output array in model coordinates
! ------------------------------------------
!
-IF (CPROGRAM=='AROME ') THEN
+IF ( LAROME ) THEN
DO JK=1,IKT
PLM (:,1,JK) = ZLM (:,JK)
END DO
@@ -511,6 +579,11 @@ end if
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+
!$acc end data
END SUBROUTINE BL89
diff --git a/src/MNH/contrav.f90 b/src/MNH/contrav.f90
index 7bf731022440766569a57e9932a0c12cd17c24d5..9b0d8e70d568d91142919e8be58e7e83494d19f5 100644
--- a/src/MNH/contrav.f90
+++ b/src/MNH/contrav.f90
@@ -522,10 +522,8 @@ USE MODD_PARAMETERS
!
USE MODE_ll
USE MODE_MPPDB
-#ifdef MNH_OPENACC
-USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
use mode_msg
-#endif
!
USE MODI_GET_HALO
USE MODI_SHUMAN
@@ -564,7 +562,7 @@ INTEGER :: IW, IE, IS, IN ! Coordinate of fourth o
INTEGER :: IINFO_ll
LOGICAL :: GDATA_ON_DEVICE
real :: ZTMP1, ZTMP2 ! Intermediate work variables
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZU_EAST, ZV_NORTH, ZDZX_EAST, ZDZY_NORTH
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZU_EAST, ZV_NORTH, ZDZX_EAST, ZDZY_NORTH
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: Z1,Z2 ! Work arrays
TYPE(LIST_ll), POINTER :: TZFIELD_U, TZFIELD_V, TZFIELD_DZX, TZFIELD_DZY
TYPE(HALO2LIST_ll), POINTER :: TZHALO2_U, TZHALO2_V, TZHALO2_DZX, TZHALO2_DZY
@@ -599,7 +597,7 @@ IJU= SIZE(PDXX,2)
IKU= SIZE(PDXX,3)
!Pin positions in the pools of MNH memory
-CALL MNH_MEM_POSITION_PIN()
+CALL MNH_MEM_POSITION_PIN( 'CONTRAV_DEVICE 1' )
CALL MNH_MEM_GET( Z1, IIU, IJU, IKU )
CALL MNH_MEM_GET( Z2, IIU, IJU, IKU )
@@ -629,7 +627,7 @@ ELSE
END IF
!
IF (KADV_ORDER == 4 ) THEN
- IF( .NOT. LFLAT) THEN
+ IF( .NOT. LFLAT) THEN
NULLIFY(TZFIELD_U)
NULLIFY(TZFIELD_V)
CALL ADD3DFIELD_ll( TZFIELD_U, PRUCT, 'CONTRAV::PRUCT' )
@@ -657,8 +655,13 @@ IF (KADV_ORDER == 4 ) THEN
!!$ END IF
!
!PW: necessary because pointers does not work with OpenACC (PGI 16.1)
- ALLOCATE(ZU_EAST(IJU,IKU),ZV_NORTH(IIU,IKU),ZDZX_EAST(IJU,IKU),ZDZY_NORTH(IIU,IKU))
-!$acc enter data create( zu_east, zv_north, zdzx_east, zdzy_north )
+ !Pin positions in the pools of MNH memory
+ CALL MNH_MEM_POSITION_PIN( 'CONTRAV_DEVICE 2' )
+
+ CALL MNH_MEM_GET( zu_east, IJU, IKU )
+ CALL MNH_MEM_GET( zv_north, IIU, IKU )
+ CALL MNH_MEM_GET( zdzx_east, IJU, IKU )
+ CALL MNH_MEM_GET( zdzy_north, IIU, IKU )
ZU_EAST(:,:) = TZHALO2_U%HALO2%EAST
ZDZX_EAST(:,:) = TZHALO2_DZX%HALO2%EAST
ZV_NORTH(:,:) = TZHALO2_V%HALO2%NORTH
@@ -727,7 +730,7 @@ IF (KADV_ORDER == 2 ) THEN
!$acc end kernels
!
ELSE IF (KADV_ORDER == 4 ) THEN
-!$acc kernels
+!$acc kernels present( zu_east, zv_north, zdzx_east, zdzy_north )
!
!!$ IF (NHALO == 1) THEN
IF ( GWEST ) THEN
@@ -883,8 +886,7 @@ PRWCT(:,:,1) = - PRWCT(:,:,3) ! Mirror hypothesis
!$acc update self(PRWCT)
!
IF (KADV_ORDER == 4 ) THEN
-!$acc exit data delete( zu_east, zv_north, zdzx_east, zdzy_north )
- DEALLOCATE(ZU_EAST,ZV_NORTH,ZDZX_EAST,ZDZY_NORTH)
+ CALL MNH_MEM_RELEASE( 'CONTRAV_DEVICE 2' )
CALL CLEANLIST_ll(TZFIELD_U)
CALL CLEANLIST_ll(TZFIELD_V)
!!$ IF (NHALO==1) THEN
@@ -902,7 +904,7 @@ END IF FLAT
!$acc end data
!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
-CALL MNH_MEM_RELEASE()
+CALL MNH_MEM_RELEASE( 'CONTRAV_DEVICE 1' )
IF (MPPDB_INITIALIZED) THEN
!Check all OUT arrays
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index f4f9fcbea68094ed101f1613c7f0ce0a119881cf..2532a0132d7717c627c936bf36e7f4e1a79d4413 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -170,6 +170,9 @@ USE MODD_MNH_SURFEX_n
!
USE MODE_DATETIME
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
#ifdef MNH_FOREFIRE
!** MODULES FOR FOREFIRE **!
@@ -240,10 +243,17 @@ REAL, DIMENSION(:,:), allocatable :: ZRAIN ! liquid precipitation (kg/m2/s)
REAL, DIMENSION(:,:), allocatable :: ZSNOW ! solid precipitation (kg/m2/s)
REAL, DIMENSION(:,:), allocatable :: ZTSUN ! solar time (s since midnight)
!
+#ifndef MNH_OPENACC
REAL, DIMENSION(:,:), allocatable :: ZUA ! u component of the wind
! ! parallel to the orography
REAL, DIMENSION(:,:), allocatable :: ZVA ! v component of the wind
! ! parallel to the orography
+#else
+REAL, DIMENSION(:,:), pointer, contiguous :: ZUA ! u component of the wind
+! ! parallel to the orography
+REAL, DIMENSION(:,:), pointer, contiguous :: ZVA ! v component of the wind
+! ! parallel to the orography
+#endif
REAL, DIMENSION(:,:), allocatable :: ZU ! zonal wind
REAL, DIMENSION(:,:), allocatable :: ZV ! meridian wind
REAL, DIMENSION(:,:), allocatable :: ZWIND ! wind parallel to the orography
@@ -376,9 +386,16 @@ allocate( ZRAIN (SIZE(PSFTH,1),SIZE(PSFTH,2)) )
allocate( ZSNOW (SIZE(PSFTH,1),SIZE(PSFTH,2)) )
allocate( ZTSUN (SIZE(PSFTH,1),SIZE(PSFTH,2)) )
+#ifndef MNH_OPENACC
allocate( ZUA (SIZE(PSFTH,1),SIZE(PSFTH,2)) )
-
allocate( ZVA (SIZE(PSFTH,1),SIZE(PSFTH,2)) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ZUA, SIZE(PSFTH,1), SIZE(PSFTH,2) )
+CALL MNH_MEM_GET( ZVA, SIZE(PSFTH,1), SIZE(PSFTH,2) )
+#endif
allocate( ZU (SIZE(PSFTH,1),SIZE(PSFTH,2)) )
allocate( ZV (SIZE(PSFTH,1),SIZE(PSFTH,2)) )
@@ -457,14 +474,14 @@ END IF
!
!$acc data copyin(XUT,XVT,XWT,XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
!$acc & XCOSSLOPE,XSINSLOPE) &
-!$acc & present(XDXX,XDYY,XDZZ) &
-!$acc copyout(ZUA,ZVA)
+!$acc & present(XDXX,XDYY,XDZZ)
CALL ROTATE_WIND(XUT,XVT,XWT, &
XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
XCOSSLOPE,XSINSLOPE, &
XDXX,XDYY,XDZZ, &
ZUA,ZVA )
!$acc end data
+!$acc update self( ZUA, ZVA )
!
! 1.4 zonal and meridian components of the wind parallel to the slope
! ---------------------------------------------------------------
@@ -840,6 +857,11 @@ IF (LDIAG_IN_RUN) THEN
CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDSURF_ll)
END IF
+
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
!
!==================================================================================
!
diff --git a/src/MNH/ice4_compute_pdf.f90 b/src/MNH/ice4_compute_pdf.f90
index 5eff4c083a615b1f597f43d3f163b342ad86bdc8..9b8f6087ede4aa45d09e3bdbfd609bdc9d68e7f0 100644
--- a/src/MNH/ice4_compute_pdf.f90
+++ b/src/MNH/ice4_compute_pdf.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -59,6 +59,9 @@ USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC,XBCRIAUTI,XACRIAUTI,XCRIAUTI
USE MODD_CST, ONLY : XTT
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MSG
!
#ifdef MNH_BITREP
@@ -96,9 +99,17 @@ REAL, DIMENSION(:), INTENT(OUT) :: PRF ! Rain fraction
!
INTEGER :: ISIZE
INTEGER :: JI
+#ifndef MNH_OPENACC
LOGICAL, DIMENSION(:), allocatable :: GWORK, GWORK2, GWORK3
+#else
+LOGICAL, DIMENSION(:), pointer,contiguous :: GWORK, GWORK2, GWORK3
+#endif
REAL :: ZCOEFFRCM
+#ifndef MNH_OPENACC
REAL, DIMENSION(:), allocatable :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF
+#else
+REAL, DIMENSION(:), pointer,contiguous :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF
+#endif
ZCRIAUTI, & !RI value to begin snow formation
ZHLC_RCMAX, & !HLCLOUDS : maximum value for RC in distribution
ZHLC_LRCLOCAL, & !HLCLOUDS : LWC that is Low LWC local in LCF
@@ -133,6 +144,7 @@ END IF
isize = size( prhodref )
+#ifndef MNH_OPENACC
allocate( gwork (isize ) )
allocate( gwork2(isize ) )
allocate( gwork3(isize ) )
@@ -144,8 +156,24 @@ allocate( zhlc_lrclocal(isize ) )
allocate( zhlc_hrclocal(isize ) )
allocate( ZSUMRC (isize ) )
allocate( ZSUMRI (isize ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_COMPUTE_PDF' )
-!$acc data create(GWORK,GWORK2,GWORK3,ZRCRAUTC,ZCRIAUTI,ZHLC_RCMAX,ZHLC_LRCLOCAL,ZHLC_HRCLOCAL, ZSUMRC, ZSUMRI)
+CALL MNH_MEM_GET( gwork, isize )
+CALL MNH_MEM_GET( gwork2, isize )
+CALL MNH_MEM_GET( gwork3, isize )
+
+CALL MNH_MEM_GET( zrcrautc, isize )
+CALL MNH_MEM_GET( zcriauti, isize )
+CALL MNH_MEM_GET( zhlc_rcmax, isize )
+CALL MNH_MEM_GET( zhlc_lrclocal, isize )
+CALL MNH_MEM_GET( zhlc_hrclocal, isize )
+CALL MNH_MEM_GET( ZSUMRC, isize )
+CALL MNH_MEM_GET( ZSUMRI, isize )
+
+!$acc data present( GWORK, GWORK2, GWORK3, ZRCRAUTC, ZCRIAUTI, ZHLC_RCMAX, ZHLC_LRCLOCAL, ZHLC_HRCLOCAL, ZSUMRC, ZSUMRI )
+#endif
!Cloud water split between high and low content part is done according to autoconversion option
!$acc kernels
@@ -174,7 +202,7 @@ IF(HSUBG_AUCV_RC=='NONE') THEN
!$acc end kernels
ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
-!$acc kernels
+!$acc kernels present( GWORK, GWORK2, GWORK3 )
!Cloud water is only in the cloudy part and entirely in low or high part
GWORK3(:) = PCF(:) > 0.
GWORK(:) = GWORK3(:) .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:)
@@ -197,9 +225,12 @@ ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
END WHERE
!$acc end kernels
ELSEIF(HSUBG_AUCV_RC=='ADJU') THEN
-!$acc kernels
+!$acc kernels present( GWORK )
ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
- GWORK(:) = ZSUMRC(:) > 0.
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : ISIZE )
+ GWORK(JI) = ZSUMRC(JI) > 0.
+ END DO
WHERE(GWORK(:))
PHLC_LRC(:)=PHLC_LRC(:)*PRCT(:)/ZSUMRC(:)
PHLC_HRC(:)=PHLC_HRC(:)*PRCT(:)/ZSUMRC(:)
@@ -216,12 +247,15 @@ ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
! 'HLCISOTRIPDF' : isocele triangular PDF
! 'SIGM' : Redelsperger and Sommeria (1986)
IF(HSUBG_PR_PDF=='SIGM') THEN
-!$acc kernels
+!$acc kernels present( GWORK, GWORK2, GWORK3 )
! Redelsperger and Sommeria (1986) but organised according to Turner (2011, 2012)
- GWORK(:) = PRCT(:)> ZRCRAUTC(:)+PSIGMA_RC(:)
- GWORK2(:) = PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. &
- PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:))
- GWORK3(:) = PRCT(:)>XRTMIN(2) .AND. PCF(:)>0.
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : ISIZE )
+ GWORK(JI) = PRCT(JI)> ZRCRAUTC(JI)+PSIGMA_RC(JI)
+ GWORK2(JI) = PRCT(JI)> (ZRCRAUTC(JI)-PSIGMA_RC(JI)) .AND. &
+ PRCT(JI)<=(ZRCRAUTC(JI)+PSIGMA_RC(JI))
+ GWORK3(JI) = PRCT(JI)>XRTMIN(2) .AND. PCF(JI)>0.
+ END DO
WHERE (GWORK(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
@@ -274,79 +308,102 @@ SELECT CASE( HSUBG_PR_PDF )
END SELECT
!$acc kernels
- GWORK(:) = PRCT(:)>0. .AND. PCF(:)>0.
- WHERE(GWORK(:))
- ZHLC_RCMAX(:)=ZCOEFFRCM*PRCT(:)/PCF(:)
- END WHERE
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : ISIZE )
+ IF ( PRCT(JI)>0. .AND. PCF(JI)>0. ) ZHLC_RCMAX(JI) = ZCOEFFRCM * PRCT(JI) / PCF(JI)
+ END DO
+!$acc end kernels
! Split available water and cloud fraction in two parts
! Calculate local mean values int he low and high parts for the 3 PDF forms:
- GWORK(:) = PRCT(:)>0. .AND. PCF(:)>0. .AND. ZHLC_RCMAX(:)>ZRCRAUTC(:)
+!$acc kernels present( GWORK )
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : ISIZE )
+ GWORK(JI) = PRCT(JI)>0. .AND. PCF(JI)>0. .AND. ZHLC_RCMAX(JI)>ZRCRAUTC(JI)
+ END DO
+!$acc end kernels
!IF(HSUBG_PR_PDF=='HLCRECTPDF') THEN
IF (IHSUBG_PR_PDF==1) THEN
+!$acc kernels present( GWORK )
WHERE(GWORK(:))
ZHLC_LRCLOCAL(:)=0.5*ZRCRAUTC(:)
ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + ZRCRAUTC(:))/2.0
END WHERE
+!$acc end kernels
!ELSE IF(HSUBG_PR_PDF=='HLCTRIANGPDF') THEN
ELSE IF (IHSUBG_PR_PDF==2) THEN
+!$acc kernels present( GWORK )
WHERE(GWORK(:))
ZHLC_LRCLOCAL(:)=( ZRCRAUTC(:) *(3.0 * ZHLC_RCMAX(:) - 2.0 * ZRCRAUTC(:) ) ) &
/ (3.0 * (2.0 * ZHLC_RCMAX(:) - ZRCRAUTC(:) ) )
ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 2.0*ZRCRAUTC(:)) / 3.0
END WHERE
+!$acc end kernels
!ELSE IF(HSUBG_PR_PDF=='HLCQUADRAPDF') THEN
ELSE IF (IHSUBG_PR_PDF==3) THEN
- WHERE(GWORK(:))
+!$acc kernels present( GWORK )
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : ISIZE )
+ IF ( GWORK(JI) ) THEN
#ifndef MNH_BITREP
- ZHLC_LRCLOCAL(:)=(3.0 *ZRCRAUTC(:)**3 - 8.0 *ZRCRAUTC(:)**2 * ZHLC_RCMAX(:) &
- + 6.0*ZRCRAUTC(:) *ZHLC_RCMAX(:)**2 ) &
- / &
- (4.0* ZRCRAUTC(:)**2 -12.0*ZRCRAUTC(:) *ZHLC_RCMAX(:) &
- + 12.0 * ZHLC_RCMAX(:)**2 )
+ ZHLC_LRCLOCAL(JI)=(3.0 *ZRCRAUTC(JI)**3 - 8.0 *ZRCRAUTC(JI)**2 * ZHLC_RCMAX(JI) &
+ + 6.0*ZRCRAUTC(JI) *ZHLC_RCMAX(JI)**2 ) &
+ / &
+ (4.0* ZRCRAUTC(JI)**2 -12.0*ZRCRAUTC(JI) *ZHLC_RCMAX(JI) &
+ + 12.0 * ZHLC_RCMAX(JI)**2 )
#else
- ZHLC_LRCLOCAL(:)=(3.0 *BR_P3(ZRCRAUTC(:)) - 8.0 *BR_P2(ZRCRAUTC(:)) * ZHLC_RCMAX(:) &
- + 6.0*ZRCRAUTC(:) *BR_P2(ZHLC_RCMAX(:)) ) &
- / &
- (4.0* BR_P2(ZRCRAUTC(:)) -12.0*ZRCRAUTC(:) *ZHLC_RCMAX(:) &
- + 12.0 * BR_P2(ZHLC_RCMAX(:)) )
+ ZHLC_LRCLOCAL(JI)=(3.0 *BR_P3(ZRCRAUTC(JI)) - 8.0 *BR_P2(ZRCRAUTC(JI)) * ZHLC_RCMAX(JI) &
+ + 6.0*ZRCRAUTC(JI) *BR_P2(ZHLC_RCMAX(JI)) ) &
+ / &
+ (4.0* BR_P2(ZRCRAUTC(JI)) -12.0*ZRCRAUTC(JI) *ZHLC_RCMAX(JI) &
+ + 12.0 * BR_P2(ZHLC_RCMAX(JI)) )
#endif
- ZHLC_HRCLOCAL(:)=(ZHLC_RCMAX(:) + 3.0*ZRCRAUTC(:))/4.0
- END WHERE
+ ZHLC_HRCLOCAL(JI)=(ZHLC_RCMAX(JI) + 3.0*ZRCRAUTC(JI))/4.0
+ END IF
+ END DO
+!$acc end kernels
!ELSE IF(HSUBG_PR_PDF=='HLCISOTRIPDF') THEN
ELSE IF (IHSUBG_PR_PDF==4) THEN
- GWORK2(:) = PRCT(:) <= ZRCRAUTC(:)*PCF(:)
- WHERE(GWORK(:))
- WHERE(GWORK2(:))
+!$acc kernels present( GWORK, GWORK2 )
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : ISIZE )
+ IF ( GWORK(JI) ) THEN
+ IF ( PRCT(JI) <= ZRCRAUTC(JI)*PCF(JI) ) THEN
#ifndef MNH_BITREP
- ZHLC_LRCLOCAL(:)=( (ZHLC_RCMAX(:))**3 &
- -(12.0 * (ZHLC_RCMAX(:))*(ZRCRAUTC(:))**2) &
- +(8.0 * ZRCRAUTC(:)**3) ) &
- /( (6.0 * (ZHLC_RCMAX(:))**2) &
- -(24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) &
- +(12.0 * ZRCRAUTC(:)**2) )
+ ZHLC_LRCLOCAL(JI)=( (ZHLC_RCMAX(JI))**3 &
+ -(12.0 * (ZHLC_RCMAX(JI))*(ZRCRAUTC(JI))**2) &
+ +(8.0 * ZRCRAUTC(JI)**3) ) &
+ /( (6.0 * (ZHLC_RCMAX(JI))**2) &
+ -(24.0 * (ZHLC_RCMAX(JI)) * ZRCRAUTC(JI)) &
+ +(12.0 * ZRCRAUTC(JI)**2) )
#else
- ZHLC_LRCLOCAL(:)=( BR_P3(ZHLC_RCMAX(:)) &
- -(12.0 * (ZHLC_RCMAX(:))*BR_P2(ZRCRAUTC(:))) &
- +(8.0 * BR_P3(ZRCRAUTC(:))) ) &
- /( (6.0 * BR_P2(ZHLC_RCMAX(:))) &
- -(24.0 * (ZHLC_RCMAX(:)) * ZRCRAUTC(:)) &
- +(12.0 * BR_P2(ZRCRAUTC(:))) )
+ ZHLC_LRCLOCAL(JI)=( BR_P3(ZHLC_RCMAX(JI)) &
+ -(12.0 * (ZHLC_RCMAX(JI))*BR_P2(ZRCRAUTC(JI))) &
+ +(8.0 * BR_P3(ZRCRAUTC(JI))) ) &
+ /( (6.0 * BR_P2(ZHLC_RCMAX(JI))) &
+ -(24.0 * (ZHLC_RCMAX(JI)) * ZRCRAUTC(JI)) &
+ +(12.0 * BR_P2(ZRCRAUTC(JI))) )
#endif
- ZHLC_HRCLOCAL(:)=( ZHLC_RCMAX(:) + 2.0 * ZRCRAUTC(:) )/3.0
- ELSEWHERE
- ZHLC_LRCLOCAL(:)=(2.0/3.0) * ZRCRAUTC(:)
+ ZHLC_HRCLOCAL(JI)=( ZHLC_RCMAX(JI) + 2.0 * ZRCRAUTC(JI) )/3.0
+ ELSE
+ ZHLC_LRCLOCAL(JI)=(2.0/3.0) * ZRCRAUTC(JI)
#ifndef MNH_BITREP
- ZHLC_HRCLOCAL(:)=(3.0*ZHLC_RCMAX(:)**3 - 8.0*ZRCRAUTC(:)**3) &
- / (6.0 * ZHLC_RCMAX(:)**2 - 12.0*ZRCRAUTC(:)**2)
+ ZHLC_HRCLOCAL(JI)=(3.0*ZHLC_RCMAX(JI)**3 - 8.0*ZRCRAUTC(JI)**3) &
+ / (6.0 * ZHLC_RCMAX(JI)**2 - 12.0*ZRCRAUTC(JI)**2)
#else
- ZHLC_HRCLOCAL(:)=(3.0*BR_P3(ZHLC_RCMAX(:)) - 8.0*BR_P3(ZRCRAUTC(:))) &
- / (6.0 * BR_P2(ZHLC_RCMAX(:)) - 12.0*BR_P2(ZRCRAUTC(:)))
+ ZHLC_HRCLOCAL(JI)=(3.0*BR_P3(ZHLC_RCMAX(JI)) - 8.0*BR_P3(ZRCRAUTC(JI))) &
+ / (6.0 * BR_P2(ZHLC_RCMAX(JI)) - 12.0*BR_P2(ZRCRAUTC(JI)))
#endif
- END WHERE
- END WHERE
+ END IF
+ END IF
+ END DO
+!$acc end kernels
END IF
+!$acc kernels present( GWORK, GWORK2 )
! Compare r_cM to r_cR to know if cloud water content is high enough to split in two parts or not
- GWORK2(:) = PRCT(:)>0. .AND. PCF(:)>0. .AND. ZHLC_RCMAX(:)<=ZRCRAUTC(:)
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : ISIZE )
+ GWORK2(JI) = PRCT(JI)>0. .AND. PCF(JI)>0. .AND. ZHLC_RCMAX(JI)<=ZRCRAUTC(JI)
+ END DO
WHERE(GWORK(:))
! Calculate final values for LCF and HCF:
PHLC_LCF(:)=PCF(:) &
@@ -379,11 +436,11 @@ ELSE
ENDIF
!
!Ice water split between high and low content part is done according to autoconversion option
-!$acc kernels
+!$acc kernels present( ZCRIAUTI)
ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI)) ! Autoconversion ri threshold
!$acc end kernels
IF(HSUBG_AUCV_RI=='NONE') THEN
-!$acc kernels
+!$acc kernels present( ZCRIAUTI)
!Cloud water is entirely in low or high part
DO JI = 1, ISIZE
IF ( PRIT(JI) > ZCRIAUTI(JI) ) THEN
@@ -405,7 +462,7 @@ IF(HSUBG_AUCV_RI=='NONE') THEN
END DO
!$acc end kernels
ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
-!$acc kernels
+!$acc kernels present( ZCRIAUTI)
!Cloud water is only in the cloudy part and entirely in low or high part
WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:))
PHLI_HCF(:)=PCF(:)
@@ -460,6 +517,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ICE4_COMPUTE_PDF' )
+#endif
+
!$acc end data
END SUBROUTINE ICE4_COMPUTE_PDF
diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90
index 0ffc2293faba561189438a594258a042e68a72a9..33ce69daa008c6c148e3f6558ba72c2f8a54075b 100644
--- a/src/MNH/ice4_fast_rh.f90
+++ b/src/MNH/ice4_fast_rh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -100,6 +100,9 @@ USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG,NWETLBDAH,NWETLBDAR,NWETLBDAS,X0DEPH,X1
USE MODI_BITREP
#endif
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
!
IMPLICIT NONE
@@ -157,6 +160,7 @@ INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRS
INTEGER :: IGWET
INTEGER :: ISIZE
INTEGER :: IDX, JJ, JL
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), allocatable :: I1
INTEGER, DIMENSION(:), allocatable :: IVEC1, IVEC2
LOGICAL, DIMENSION(:), allocatable :: GWET
@@ -165,6 +169,16 @@ REAL, DIMENSION(:), allocatable :: ZVEC1, ZVEC2, ZVEC3
REAL, DIMENSION(:), allocatable :: ZZW, &
ZRDRYH_INIT, ZRWETH_INIT, &
ZRDRYHG
+#else
+INTEGER, DIMENSION(:), pointer, contiguous :: I1
+INTEGER, DIMENSION(:), pointer, contiguous :: IVEC1, IVEC2
+LOGICAL, DIMENSION(:), pointer, contiguous :: GWET
+REAL, DIMENSION(:), pointer, contiguous :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
+REAL, DIMENSION(:), pointer, contiguous :: ZVEC1, ZVEC2, ZVEC3
+REAL, DIMENSION(:), pointer, contiguous :: ZZW, &
+ ZRDRYH_INIT, ZRWETH_INIT, &
+ ZRDRYHG
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -213,25 +227,47 @@ END IF
ISIZE = Size( PRHODREF )
-allocate( i1 ( size( prhodref ) ) )
-allocate( ivec1 ( size( prhodref ) ) )
-allocate( ivec2 ( size( prhodref ) ) )
-allocate( gwet ( size( prhodref ) ) )
-allocate( zhail ( size( prhodref ) ) )
-allocate( zwet ( size( prhodref ) ) )
-allocate( zmask ( size( prhodref ) ) )
-allocate( zweth ( size( prhodref ) ) )
-allocate( zdryh ( size( prhodref ) ) )
-allocate( zvec1 ( size( prhodref ) ) )
-allocate( zvec2 ( size( prhodref ) ) )
-allocate( zvec3 ( size( prhodref ) ) )
-allocate( zzw ( size( prhodref ) ) )
-allocate( zrdryh_init( size( prhodref ) ) )
-allocate( zrweth_init( size( prhodref ) ) )
-allocate( zrdryhg ( size( prhodref ) ) )
+#ifndef MNH_OPENACC
+allocate( i1 ( isize ) )
+allocate( ivec1 ( isize ) )
+allocate( ivec2 ( isize ) )
+allocate( gwet ( isize ) )
+allocate( zhail ( isize ) )
+allocate( zwet ( isize ) )
+allocate( zmask ( isize ) )
+allocate( zweth ( isize ) )
+allocate( zdryh ( isize ) )
+allocate( zvec1 ( isize ) )
+allocate( zvec2 ( isize ) )
+allocate( zvec3 ( isize ) )
+allocate( zzw ( isize ) )
+allocate( zrdryh_init( isize ) )
+allocate( zrweth_init( isize ) )
+allocate( zrdryhg ( isize ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_FAST_RH' )
+
+CALL MNH_MEM_GET( i1, isize )
+CALL MNH_MEM_GET( ivec1, isize )
+CALL MNH_MEM_GET( ivec2, isize )
+CALL MNH_MEM_GET( gwet, isize )
+CALL MNH_MEM_GET( zhail, isize )
+CALL MNH_MEM_GET( zwet, isize )
+CALL MNH_MEM_GET( zmask, isize )
+CALL MNH_MEM_GET( zweth, isize )
+CALL MNH_MEM_GET( zdryh, isize )
+CALL MNH_MEM_GET( zvec1, isize )
+CALL MNH_MEM_GET( zvec2, isize )
+CALL MNH_MEM_GET( zvec3, isize )
+CALL MNH_MEM_GET( zzw, isize )
+CALL MNH_MEM_GET( zrdryh_init, isize )
+CALL MNH_MEM_GET( zrweth_init, isize )
+CALL MNH_MEM_GET( zrdryhg, isize )
-!$acc data create(I1,IVEC1,IVEC2,GWET, ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH, &
-!$acc& ZVEC1,ZVEC2,ZVEC3,ZZW,ZRDRYH_INIT,ZRWETH_INIT,ZRDRYHG)
+!$acc data present( I1, IVEC1, IVEC2, GWET, ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH, &
+!$acc& ZVEC1, ZVEC2, ZVEC3, ZZW, ZRDRYH_INIT, ZRWETH_INIT, ZRDRYHG )
+#endif
!
!* 7.2 compute the Wet and Dry growth of hail
@@ -805,6 +841,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ICE4_FAST_RH' )
+#endif
+
!$acc end data
END SUBROUTINE ICE4_FAST_RH
diff --git a/src/MNH/ice4_fast_ri.f90 b/src/MNH/ice4_fast_ri.f90
index d542b63134791edeaf75c3e5bab8835d103e9fa6..b4379ba011bd4a08fe384ed59f6f1432df43f2eb 100644
--- a/src/MNH/ice4_fast_ri.f90
+++ b/src/MNH/ice4_fast_ri.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -71,6 +71,9 @@ USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPI,X2DEPI
USE MODI_BITREP
#endif
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
!
IMPLICIT NONE
@@ -97,7 +100,11 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
!
INTEGER :: ISIZE
INTEGER :: JL
+#ifndef MNH_OPENACC
REAL, DIMENSION(:), allocatable :: ZMASK
+#else
+REAL, DIMENSION(:), pointer, contiguous :: ZMASK
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -125,9 +132,16 @@ END IF
ISIZE = Size( PRHODREF )
+#ifndef MNH_OPENACC
allocate( zmask( size( prhodref ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_FAST_RI' )
+
+CALL MNH_MEM_GET( zmask, ISIZE )
!$acc data create(ZMASK)
+#endif
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
@@ -176,6 +190,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ICE4_FAST_RI' )
+#endif
+
!$acc end data
END SUBROUTINE ICE4_FAST_RI
diff --git a/src/MNH/ice4_nucleation.f90 b/src/MNH/ice4_nucleation.f90
index 91e8a9a49320da158e176e301e5dd0db87d1b844..75c76b335defc087a5dd2c7c8c5830efe575fd08 100644
--- a/src/MNH/ice4_nucleation.f90
+++ b/src/MNH/ice4_nucleation.f90
@@ -53,6 +53,9 @@ USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1,XALPHA2,XBETA1,XBETA2,XMNU0,XNU10,XNU20
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
!
#ifdef MNH_BITREP
@@ -81,12 +84,21 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
!* 0.2 declaration of local variables
!
INTEGER :: JI
+#ifndef MNH_OPENACC
LOGICAL, DIMENSION(:), allocatable :: GNEGT ! Test where to compute the HEN process
LOGICAL, DIMENSION(:), allocatable :: GWORK, GWORK2
REAL, DIMENSION(:), allocatable :: ZW ! work array
REAL, DIMENSION(:), allocatable :: ZZW, & ! Work array
ZUSW, & ! Undersaturation over water
ZSSI ! Supersaturation over ice
+#else
+LOGICAL, DIMENSION(:), pointer, contiguous :: GNEGT ! Test where to compute the HEN process
+LOGICAL, DIMENSION(:), pointer, contiguous :: GWORK, GWORK2
+REAL, DIMENSION(:), pointer, contiguous :: ZW ! work array
+REAL, DIMENSION(:), pointer, contiguous :: ZZW, & ! Work array
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+#endif
!$acc data present(ODCOMPUTE,PTHT,PPABST,PRHODREF,PEXN,PLSFACT,PT,PRVT,PCIT,PRVHENI_MR,PB_TH,PB_RV,PB_RI)
@@ -108,6 +120,7 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PB_RI,"ICE4_NUCLEATION beg:PB_RI")
END IF
+#ifndef MNH_OPENACC
allocate( gnegt (size( odcompute ) ) )
allocate( gwork (size( odcompute ) ) )
allocate( gwork2(size( odcompute ) ) )
@@ -115,8 +128,20 @@ allocate( zw (size( odcompute ) ) )
allocate( zzw (size( odcompute ) ) )
allocate( zusw (size( odcompute ) ) )
allocate( zssi (size( odcompute ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_NUCLEATION' )
-!$acc data create(GNEGT,GWORK,GWORK2,ZW,ZZW,ZUSW,ZSSI)
+CALL MNH_MEM_GET( gnegt, size( odcompute ) )
+CALL MNH_MEM_GET( gwork, size( odcompute ) )
+CALL MNH_MEM_GET( gwork2, size( odcompute ) )
+CALL MNH_MEM_GET( zw, size( odcompute ) )
+CALL MNH_MEM_GET( zzw, size( odcompute ) )
+CALL MNH_MEM_GET( zusw, size( odcompute ) )
+CALL MNH_MEM_GET( zssi, size( odcompute ) )
+
+!$acc data present( GNEGT, GWORK, GWORK2, ZW, ZZW, ZUSW, ZSSI )
+#endif
!$acc kernels
PRVHENI_MR(:)=0.
@@ -126,34 +151,43 @@ IF(.NOT. ODSOFT) THEN
ZSSI(:)=0.
ZUSW(:)=0.
ZZW(:)=0.
- WHERE(GNEGT(:))
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : size( odcompute ) )
+ IF ( GNEGT(ji) ) THEN
#ifndef MNH_BITREP
- ZZW(:)=ALOG(PT(:))
- ZUSW(:)=EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w
- ZZW(:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
+ ZZW(JI)=ALOG(PT(JI))
+ ZUSW(JI)=EXP(XALPW - XBETAW/PT(JI) - XGAMW*ZZW(JI)) ! es_w
+ ZZW(JI)=EXP(XALPI - XBETAI/PT(JI) - XGAMI*ZZW(JI)) ! es_i
#else
- ZZW(:) = BR_LOG(PT(:))
- ZUSW(:) = BR_EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w
- ZZW(:) = BR_EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
+ ZZW(JI) = BR_LOG(PT(JI))
+ ZUSW(JI) = BR_EXP(XALPW - XBETAW/PT(JI) - XGAMW*ZZW(JI)) ! es_w
+ ZZW(JI) = BR_EXP(XALPI - XBETAI/PT(JI) - XGAMI*ZZW(JI)) ! es_i
#endif
- END WHERE
- WHERE(GNEGT(:))
- ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
- ! Supersaturation over ice
- ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
- ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
- ! Supersaturation of saturated water vapor over ice
- !
- !* 3.1 compute the heterogeneous nucleation source RVHENI
- !
- !* 3.1.1 compute the cloud ice concentration
- !
- ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
- END WHERE
+ END IF
+ END DO
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : size( odcompute ) )
+ IF ( GNEGT(ji) ) THEN
+ ZZW(JI)=MIN(PPABST(JI)/2., ZZW(JI)) ! safety limitation
+ ZSSI(JI)=PRVT(JI)*(PPABST(JI)-ZZW(JI)) / (XEPSILO*ZZW(JI)) - 1.0
+ ! Supersaturation over ice
+ ZUSW(JI)=MIN(PPABST(JI)/2., ZUSW(JI)) ! safety limitation
+ ZUSW(JI)=(ZUSW(JI)/ZZW(JI))*((PPABST(JI)-ZZW(JI))/(PPABST(JI)-ZUSW(JI))) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+ !
+ !* 3.1 compute the heterogeneous nucleation source RVHENI
+ !
+ !* 3.1.1 compute the cloud ice concentration
+ !
+ ZSSI(JI)=MIN(ZSSI(JI), ZUSW(JI)) ! limitation of SSi according to SSw=0
+ END IF
+ END DO
ZZW(:)=0.
- GWORK(:) = GNEGT(:) .AND. PT(:)<XTT-5.0 .AND. ZSSI(:)>0.0
- GWORK2(:) = GNEGT(:) .AND. PT(:)<=XTT-2.0 .AND. PT(:)>=XTT-5.0 .AND. ZSSI(:)>0.0
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : size( odcompute ) )
+ GWORK(JI) = GNEGT(JI) .AND. PT(JI)<XTT-5.0 .AND. ZSSI(JI)>0.0
+ GWORK2(JI) = GNEGT(JI) .AND. PT(JI)<=XTT-2.0 .AND. PT(JI)>=XTT-5.0 .AND. ZSSI(JI)>0.0
+ END DO
#ifndef MNH_BITREP
#ifndef MNH_OPENACC
WHERE(GWORK(:))
@@ -193,10 +227,11 @@ IF(.NOT. ODSOFT) THEN
END DO
#endif
#endif
- WHERE(GNEGT(:))
- ZZW(:)=ZZW(:)-PCIT(:)
- ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
- END WHERE
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : size( odcompute ) )
+ ZZW(JI)=ZZW(JI)-PCIT(JI)
+ ZZW(JI)=MIN(ZZW(JI), 50.E3) ! limitation provisoire a 50 l^-1
+ END DO
WHERE(GNEGT(:))
!
!* 3.1.2 update the r_i and r_v mixing ratios
@@ -206,12 +241,16 @@ IF(.NOT. ODSOFT) THEN
END WHERE
!Limitation due to 0 crossing of temperature
IF(LFEEDBACKT) THEN
- ZW(:)=0.
- WHERE(GNEGT(:))
- ZW(:)=MIN(PRVHENI_MR(:), &
- MAX(0., (XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
- MAX(PRVHENI_MR(:), 1.E-20)
- END WHERE
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : size( odcompute ) )
+ IF ( GNEGT(JI) ) THEN
+ ZW(JI)=MIN(PRVHENI_MR(JI), &
+ MAX(0., (XTT/PEXN(JI)-PTHT(JI))/PLSFACT(JI))) / &
+ MAX(PRVHENI_MR(JI), 1.E-20)
+ ELSE
+ ZW(JI) = 0.
+ END IF
+ END DO
ELSE
ZW(:)=1.
ENDIF
@@ -236,6 +275,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ICE4_NUCLEATION' )
+#endif
+
!$acc end data
END SUBROUTINE ICE4_NUCLEATION
diff --git a/src/MNH/ice4_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90
index c19bc25290320383c06ed618144e22c24351d62f..74df1318aead24a5cac0de764f031c4a2bcadf42 100644
--- a/src/MNH/ice4_nucleation_wrapper.f90
+++ b/src/MNH/ice4_nucleation_wrapper.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -49,6 +49,9 @@ SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
!
USE MODD_CST, ONLY: XTT
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
use mode_tools, only: Countjv
#ifdef MNH_OPENACC
@@ -79,6 +82,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due
INTEGER :: IDX, JI, JJ, JK
INTEGER :: JL
INTEGER :: INEGT, INEGT_TMP
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), ALLOCATABLE :: I1,I2,I3
LOGICAL :: GDSOFT
LOGICAL, DIMENSION(:), ALLOCATABLE :: GLDCOMPUTE
@@ -93,6 +97,22 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
ZLSFACT, &
ZRVHENI_MR, &
ZB_TH, ZB_RV, ZB_RI
+#else
+INTEGER, DIMENSION(:), pointer, contiguous :: I1,I2,I3
+LOGICAL :: GDSOFT
+LOGICAL, DIMENSION(:), pointer, contiguous :: GLDCOMPUTE
+LOGICAL, DIMENSION(:,:,:), pointer, contiguous :: GNEGT ! Test where to compute the HEN process
+REAL, DIMENSION(:), pointer, contiguous :: ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZRVT, & ! Water vapor m.r. at t
+ ZCIT, & ! Pristine ice conc. at t
+ ZTHT, & ! Theta at t
+ ZRHODREF, &
+ ZEXN, &
+ ZLSFACT, &
+ ZRVHENI_MR, &
+ ZB_TH, ZB_RV, ZB_RI
+#endif
!
!$acc data present(LDMASK,PTHT,PPABST,PRHODREF,PEXN,PLSFACT,PT,PRVT,PCIT,PRVHENI_MR)
@@ -112,9 +132,16 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PCIT,"ICE4_NUCLEATION_WRAPPER beg:PCIT")
END IF
+#ifndef MNH_OPENACC
allocate( gnegt(kit, kjt, kkt ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_NUCLEATION_WRAPPER 1' )
-!$acc data create( gnegt )
+CALL MNH_MEM_GET( gnegt, kit, kjt, kkt )
+
+!$acc data present( gnegt )
+#endif
!
! optimization by looking for locations where
! the temperature is negative only !!!
@@ -124,6 +151,7 @@ GNEGT(:,:,:)=PT(:,:,:)<XTT .AND. LDMASK
INEGT = COUNT(GNEGT(:,:,:))
!$acc end kernels
!
+#ifndef MNH_OPENACC
ALLOCATE(GLDCOMPUTE(INEGT))
ALLOCATE(I1(INEGT),I2(INEGT),I3(INEGT))
ALLOCATE(ZZT(INEGT))
@@ -138,9 +166,30 @@ ALLOCATE(ZRVHENI_MR(INEGT))
ALLOCATE(ZB_TH(INEGT))
ALLOCATE(ZB_RV(INEGT))
ALLOCATE(ZB_RI(INEGT))
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_NUCLEATION_WRAPPER 2' )
-!$acc data create(GLDCOMPUTE,I1,I2,I3,ZZT,ZPRES,ZRVT,ZCIT,ZTHT, &
-!$acc& ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR,ZB_TH,ZB_RV,ZB_RI)
+CALL MNH_MEM_GET( GLDCOMPUTE, INEGT )
+CALL MNH_MEM_GET( I1, INEGT )
+CALL MNH_MEM_GET( I2, INEGT )
+CALL MNH_MEM_GET( I3, INEGT )
+CALL MNH_MEM_GET( ZZT, INEGT )
+CALL MNH_MEM_GET( ZPRES, INEGT )
+CALL MNH_MEM_GET( ZRVT, INEGT )
+CALL MNH_MEM_GET( ZCIT, INEGT )
+CALL MNH_MEM_GET( ZTHT, INEGT )
+CALL MNH_MEM_GET( ZRHODREF, INEGT )
+CALL MNH_MEM_GET( ZEXN, INEGT )
+CALL MNH_MEM_GET( ZLSFACT, INEGT )
+CALL MNH_MEM_GET( ZRVHENI_MR, INEGT )
+CALL MNH_MEM_GET( ZB_TH, INEGT )
+CALL MNH_MEM_GET( ZB_RV, INEGT )
+CALL MNH_MEM_GET( ZB_RI, INEGT )
+
+!$acc data present( GLDCOMPUTE, I1, I2, I3, ZZT, ZPRES, ZRVT, ZCIT, ZTHT, &
+!$acc& ZRHODREF, ZEXN, ZLSFACT, ZRVHENI_MR, ZB_TH, ZB_RV, ZB_RI )
+#endif
!
#ifndef MNH_OPENACC
@@ -164,9 +213,9 @@ IF(INEGT>0) THEN
ZRHODREF(JL)=PRHODREF(I1(JL), I2(JL), I3(JL))
ZEXN(JL)=PEXN(I1(JL), I2(JL), I3(JL))
ZLSFACT(JL)=PLSFACT(I1(JL), I2(JL), I3(JL))
+ GLDCOMPUTE(JL) = ZZT(JL)<XTT
ENDDO
GDSOFT = .FALSE.
- GLDCOMPUTE(:) = ZZT(:)<XTT
ZB_TH(:) = 0.
ZB_RV(:) = 0.
ZB_RI(:) = 0.
@@ -192,10 +241,16 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRVHENI_MR,"ICE4_NUCLEATION_WRAPPER end:PRVHENI_MR")
END IF
+#ifdef MNH_OPENACC
!$acc end data
+CALL MNH_MEM_RELEASE( 'ICE4_NUCLEATION_WRAPPER 2' )
+
!$acc end data
+CALL MNH_MEM_RELEASE( 'ICE4_NUCLEATION_WRAPPER 1' )
+
!$acc end data
+#endif
END SUBROUTINE ICE4_NUCLEATION_WRAPPER
diff --git a/src/MNH/ice4_rimltc.f90 b/src/MNH/ice4_rimltc.f90
index 971a2ac6ae74af0ce7cf7a2f2671356c1833a60f..650e9394888844a56094ef28b1dba76f8cf25e8a 100644
--- a/src/MNH/ice4_rimltc.f90
+++ b/src/MNH/ice4_rimltc.f90
@@ -51,6 +51,9 @@ SUBROUTINE ICE4_RIMLTC(LDSOFT, PCOMPUTE, &
USE MODD_CST, ONLY: XTT
USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
!
IMPLICIT NONE
@@ -74,7 +77,11 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
!
INTEGER :: ISIZE
INTEGER :: JL
+#ifndef MNH_OPENACC
REAL, DIMENSION(:), allocatable :: ZMASK
+#else
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZMASK
+#endif
!$acc data present(PCOMPUTE,PEXN,PLVFACT,PLSFACT,PT, &
!$acc& PTHT,PRIT,PRIMLTC_MR,PB_TH,PB_RC,PB_RI)
@@ -97,9 +104,16 @@ END IF
isize = Size( pcompute )
+#ifndef MNH_OPENACC
allocate( zmask(isize) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
-!$acc data create(ZMASK)
+CALL MNH_MEM_GET( zmask, isize )
+
+!$acc data present(ZMASK)
+#endif
!
!* 7.1 cloud ice melting
!
@@ -126,7 +140,14 @@ DO JL=1, ISIZE
PB_TH(JL) = PB_TH(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
ENDDO
!$acc end kernels
-!
+
+!$acc end data
+
+#ifdef MNH_OPENACC
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE()
+#endif
+
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PB_TH,"ICE4_RIMLTC end:PB_TH")
@@ -138,6 +159,4 @@ END IF
!$acc end data
-!$acc end data
-
END SUBROUTINE ICE4_RIMLTC
diff --git a/src/MNH/ice4_rrhong.f90 b/src/MNH/ice4_rrhong.f90
index 7e4857821edf579d8a3eb627b167275c9bd1af09..042c9ed3fec631876270407e70e6ef42a0348ccf 100644
--- a/src/MNH/ice4_rrhong.f90
+++ b/src/MNH/ice4_rrhong.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -52,6 +52,9 @@ USE MODD_CST, ONLY: XTT
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
!
IMPLICIT NONE
@@ -75,7 +78,11 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
!
INTEGER :: ISIZE
INTEGER :: JL
+#ifndef MNH_OPENACC
REAL, DIMENSION(:), allocatable :: ZMASK
+#else
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZMASK
+#endif
!
!$acc data present(PCOMPUTE,PEXN,PLVFACT,PLSFACT,PT,PRRT,PTHT, &
!$acc& PRRHONG_MR,PB_TH,PB_RR,PB_RG)
@@ -97,9 +104,16 @@ END IF
isize = Size( prrt )
+#ifndef MNH_OPENACC
allocate( zmask(isize) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
-!$acc data create(ZMASK)
+CALL MNH_MEM_GET( zmask, isize )
+
+!$acc data present(ZMASK)
+#endif
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
@@ -125,7 +139,14 @@ DO JL=1, ISIZE
PB_TH(JL) = PB_TH(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
ENDDO
!$acc end kernels
-!
+
+!$acc end data
+
+#ifdef MNH_OPENACC
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE()
+#endif
+
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PB_TH,"ICE4_RRHONG end:PB_TH")
@@ -137,6 +158,4 @@ END IF
!$acc end data
-!$acc end data
-
END SUBROUTINE ICE4_RRHONG
diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90
index 8bd8a116133ea101d425cfb2f2a0e618c541e4b6..6d4fb2fd3e097a3dda66de2319448bbf32aba4c9 100644
--- a/src/MNH/ice4_rsrimcg_old.f90
+++ b/src/MNH/ice4_rsrimcg_old.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -57,6 +57,9 @@ USE MODD_RAIN_ICE_PARAM, ONLY: NGAMINC,XEXSRIMCG,XGAMINC_RIM2,XRIMINTP1,XRIMINTP
USE MODI_BITREP
#endif
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
!
IMPLICIT NONE
@@ -78,10 +81,17 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
!
INTEGER :: IDX, JL
INTEGER :: IGRIM
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), allocatable :: IVEC1, IVEC2
LOGICAL, DIMENSION(:), allocatable :: GRIM
REAL, DIMENSION(:), allocatable :: ZVEC1, ZVEC2
REAL, DIMENSION(:), allocatable :: ZZW
+#else
+INTEGER, DIMENSION(:), pointer, contiguous :: IVEC1, IVEC2
+LOGICAL, DIMENSION(:), pointer, contiguous :: GRIM
+REAL, DIMENSION(:), pointer, contiguous :: ZVEC1, ZVEC2
+REAL, DIMENSION(:), pointer, contiguous :: ZZW
+#endif
!
!$acc data present(ODCOMPUTE,PRHODREF,PLBDAS, &
!$acc& PT,PRCT,PRST,PRSRIMCG_MR,PB_RS,PB_RG)
@@ -100,14 +110,26 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PB_RG,"ICE4_RSRIMCG_OLD beg:PB_RG")
END IF
+#ifndef MNH_OPENACC
allocate( ivec1(size( prhodref ) ) )
allocate( ivec2(size( prhodref ) ) )
allocate( grim (size( prhodref ) ) )
allocate( zvec1(size( prhodref ) ) )
allocate( zvec2(size( prhodref ) ) )
allocate( zzw (size( prhodref ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_RSRIMCG_OLD' )
-!$acc data create( IVEC1, IVEC2, GRIM, ZVEC1, ZVEC2, ZZW)
+CALL MNH_MEM_GET( ivec1, size( prhodref ) )
+CALL MNH_MEM_GET( ivec2, size( prhodref ) )
+CALL MNH_MEM_GET( grim, size( prhodref ) )
+CALL MNH_MEM_GET( zvec1, size( prhodref ) )
+CALL MNH_MEM_GET( zvec2, size( prhodref ) )
+CALL MNH_MEM_GET( zzw, size( prhodref ) )
+
+!$acc data present( IVEC1, IVEC2, GRIM, ZVEC1, ZVEC2, ZZW )
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -135,46 +157,54 @@ IF(.NOT. ODSOFT) THEN
!
! 5.1.1 select the PLBDAS
!
- DO JL = 1, IGRIM
+!$acc loop independent
+ DO CONCURRENT( JL = 1 : IGRIM )
ZVEC1(JL) = PLBDAS(IVEC1(JL))
- END DO
- !
- ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
- ! set of Lbda_s used to tabulate some moments of the incomplete
- ! gamma function
- !
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
+ !
+ ! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
+ ! set of Lbda_s used to tabulate some moments of the incomplete
+ ! gamma function
+ !
+ ZVEC2(JL) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
#ifndef MNH_BITREP
- XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ XRIMINTP1 * LOG( ZVEC1(JL) ) + XRIMINTP2 ) )
#else
- XRIMINTP1 * BR_LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ XRIMINTP1 * BR_LOG( ZVEC1(JL) ) + XRIMINTP2 ) )
#endif
- IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
- ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+ IVEC2(JL) = INT( ZVEC2(JL) )
+ ZVEC2(JL) = ZVEC2(JL) - REAL( IVEC2(JL) )
- !
- ! 5.1.5 perform the linear interpolation of the normalized
- ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2)
- !
- ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW(:) = 0.
- DO JL = 1, IGRIM
+ !
+ ! 5.1.5 perform the linear interpolation of the normalized
+ ! "XBS"-moment of the incomplete gamma function (XGAMINC_RIM2)
+ !
+ ZVEC1(JL) = XGAMINC_RIM2( IVEC2(JL)+1 )* ZVEC2(JL) &
+ - XGAMINC_RIM2( IVEC2(JL) )*(ZVEC2(JL) - 1.0)
+ END DO
+!$acc loop independent
+ DO CONCURRENT( JL = 1 : size( prhodref ) )
+ ZZW(JL) = 0.
+ END DO
+!$acc loop independent
+ DO CONCURRENT( JL = 1 : IGRIM )
ZZW(IVEC1(JL)) = ZVEC1(JL)
END DO
!
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
!
- WHERE(GRIM(:))
+!$acc loop independent
+ DO CONCURRENT( JL = 1 : size( prhodref ) )
+ IF ( GRIM(JL) ) THEN
#ifndef MNH_BITREP
- PRSRIMCG_MR(:) = XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
+ PRSRIMCG_MR(:) = XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
#else
- PRSRIMCG_MR(:) = XSRIMCG * BR_POW(PLBDAS(:),XEXSRIMCG) & ! RSRIMCG
+ PRSRIMCG_MR(:) = XSRIMCG * BR_POW(PLBDAS(:),XEXSRIMCG) & ! RSRIMCG
#endif
- * (1.0 - ZZW(:) )/PRHODREF(:)
- PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
- END WHERE
+ * (1.0 - ZZW(:) )/PRHODREF(:)
+ PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
+ END IF
+ END DO
END IF
ENDIF
PB_RS(:) = PB_RS(:) - PRSRIMCG_MR(:)
@@ -191,6 +221,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ICE4_RSRIMCG_OLD' )
+#endif
+
!$acc end data
END SUBROUTINE ICE4_RSRIMCG_OLD
diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90
index 9a1d3049ef80600c67454f0875ff759adadcf902..cd6c6e0c0298f825e3dad8dd06363130e42a62b0 100644
--- a/src/MNH/ice4_sedimentation_split.f90
+++ b/src/MNH/ice4_sedimentation_split.f90
@@ -82,8 +82,10 @@ USE MODD_PARAM_ICE, ONLY: XSPLIT_MAXCFL
USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAC,XALPHAC2,XCONC_LAND,XCONC_SEA,XCONC_URBAN,XLBC,XNUC,XNUC2
USE MODD_RAIN_ICE_PARAM, ONLY: XFSEDC
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
-USE MODE_MSG
!
USE MODI_GAMMA
!
@@ -133,6 +135,7 @@ REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipi
INTEGER :: JI,JJ,JK
LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
REAL :: ZINVTSTEP
+#ifndef MNH_OPENACC
REAL, DIMENSION(:,:), allocatable :: ZCONC_TMP ! Weighted concentration
REAL, DIMENSION(:,:,:), allocatable :: ZW ! work array
REAL, DIMENSION(:,:,:), allocatable :: ZCONC3D, & ! droplet condensation
@@ -146,6 +149,21 @@ REAL, DIMENSION(:,:,:), allocatable :: ZCONC3D, & ! droplet condensation
& ZRST, &
& ZRGT, &
& ZRHT
+#else
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZW ! work array
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZCONC3D, & ! droplet condensation
+ ZRAY, & ! Cloud Mean radius
+ ZLBC, & ! XLBC weighted by sea fraction
+ ZFSEDC, &
+ ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
+ ZRCT, &
+ ZRRT, &
+ ZRIT, &
+ ZRST, &
+ ZRGT, &
+ ZRHT
+#endif
!-------------------------------------------------------------------------------
!$acc data present( PDZZ, PRHODREF, PPABST, PTHT, PRHODJ, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT, &
@@ -175,6 +193,8 @@ IF (MPPDB_INITIALIZED) THEN
IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"ICE4_SEDIMENTATION_SPLIT beg:PRHS")
END IF
+
+#ifndef MNH_OPENACC
allocate( zconc_tmp(size( prhodref, 1 ), size( prhodref, 2 ) ) )
allocate( zw(size( prhodref, 1 ), size( prhodref, 2 ), KKTB : KKTE ) )
@@ -195,10 +215,37 @@ allocate( zrit (size( prhodref, 1 ), size( prhodref, 2 ), size( prhodref, 3 )
allocate( zrst (size( prhodref, 1 ), size( prhodref, 2 ), size( prhodref, 3 ) ) )
allocate( zrgt (size( prhodref, 1 ), size( prhodref, 2 ), size( prhodref, 3 ) ) )
allocate( zrht (size( prhodref, 1 ), size( prhodref, 2 ), size( prhodref, 3 ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( zconc_tmp, KIT , KJT )
+
+CALL MNH_MEM_GET( zw, 1, KIT, 1, KJT, KKTB, KKTE )
+
+CALL MNH_MEM_GET( zconc3d, KIT, KJT, KKT )
+CALL MNH_MEM_GET( zray , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zlbc , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zfsedc , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zprcs , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zprrs , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zpris , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zprss , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zprgs , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zprhs , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zrct , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zrrt , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zrit , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zrst , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zrgt , KIT, KJT, KKT )
+CALL MNH_MEM_GET( zrht , KIT, KJT, KKT )
+
+!$acc data present( zconc_tmp, zw, &
+!$acc& zconc3d, zray, zlbc, zfsedc, zprcs, zprrs, zpris, zprss, zprgs, zprhs, &
+!$acc& zrct, zrrt, zrit, zrst, zrgt, zrht )
+
+#endif
-!$acc data create( zconc_tmp, zw, &
-!$acc& zconc3d, zray, zlbc, zfsedc, zprcs, zprrs, zpris, zprss, zprgs, zprhs, &
-!$acc& zrct, zrrt, zrit, zrst, zrgt, zrht )
!
IF (PRESENT(PFPR)) THEN
@@ -226,30 +273,43 @@ END IF
!
!* 1. Parameters for cloud sedimentation
!
-!$acc kernels
IF (OSEDIC) THEN
+!$acc kernels
ZRAY(:,:,:) = 0.
ZLBC(:,:,:) = XLBC(1)
ZFSEDC(:,:,:) = XFSEDC(1)
ZCONC3D(:,:,:)= XCONC_LAND
ZCONC_TMP(:,:)= XCONC_LAND
+!$acc end kernels
IF (GPRESENT_PSEA) THEN
+!$acc kernels
ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
-!$acc loop independent
- DO JK=KKTB, KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
+!$acc end kernels
+!$acc kernels
+!$acc loop independent collapse(3)
+ DO JK = KKTB, KKTE
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZLBC(JI,JJ,JK) = PSEA(JI,JJ)*XLBC(2)+(1.-PSEA(JI,JJ))*XLBC(1)
+ ZFSEDC(JI,JJ,JK) = (PSEA(JI,JJ)*XFSEDC(2)+(1.-PSEA(JI,JJ))*XFSEDC(1))
+ ZFSEDC(JI,JJ,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(JI,JJ,JK))
+ ZCONC3D(JI,JJ,JK)= (1.-PTOWN(JI,JJ))*ZCONC_TMP(JI,JJ)+PTOWN(JI,JJ)*XCONC_URBAN
+ ZRAY(JI,JJ,JK) = 0.5*((1.-PSEA(JI,JJ))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
+ PSEA(JI,JJ)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ END DO
+ END DO
+ END DO
+!$acc end kernels
ELSE
+!$acc kernels
ZCONC3D(:,:,:) = XCONC_LAND
ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+!$acc end kernels
END IF
+!$acc kernels
ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+!$acc end kernels
ENDIF
!
!* 2. compute the fluxes
@@ -260,8 +320,11 @@ ENDIF
!
! External tendecies
IF (OSEDIC) THEN
+!$acc kernels
ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)*ZINVTSTEP
+!$acc end kernels
ENDIF
+!$acc kernels
ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)*ZINVTSTEP
ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)*ZINVTSTEP
ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)*ZINVTSTEP
@@ -382,6 +445,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+
!$acc end data
!
CONTAINS
diff --git a/src/MNH/ice4_slow.f90 b/src/MNH/ice4_slow.f90
index 0ac9afd761a8676d0966204bfb78043c9c682117..53e4d3758ee300b986ac803f05a7d8921ec17baf 100644
--- a/src/MNH/ice4_slow.f90
+++ b/src/MNH/ice4_slow.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -78,6 +78,9 @@ USE MODD_RAIN_ICE_PARAM, ONLY: X0DEPG,X0DEPS,X1DEPG,X1DEPS,XACRIAUTI,XALPHA3,XBC
USE MODI_BITREP
#endif
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
!
IMPLICIT NONE
@@ -118,8 +121,13 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
!
INTEGER :: ISIZE
INTEGER :: JL
+#ifndef MNH_OPENACC
REAL, DIMENSION(:), allocatable :: ZMASK
REAL, DIMENSION(:), allocatable :: ZCRIAUTI
+#else
+REAL, DIMENSION(:), pointer, contiguous :: ZMASK
+REAL, DIMENSION(:), pointer, contiguous :: ZCRIAUTI
+#endif
REAL :: ZTIMAUTIC
!
!$acc data present(PCOMPUTE,PRHODREF,PT,PSSI,PLVFACT,PLSFACT, &
@@ -163,10 +171,18 @@ END IF
ISIZE = Size( PRHODREF )
-allocate( zmask (size( prhodref ) ) )
-allocate( zcriauti(size( prhodref ) ) )
+#ifndef MNH_OPENACC
+allocate( zmask (isize) )
+allocate( zcriauti(isize) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_SLOW' )
+
+CALL MNH_MEM_GET( zmask, isize )
+CALL MNH_MEM_GET( zcriauti, isize )
-!$acc data create(ZCRIAUTI,ZMASK)
+!$acc data present( ZCRIAUTI, ZMASK )
+#endif
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
@@ -353,6 +369,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ICE4_SLOW' )
+#endif
+
!$acc end data
END SUBROUTINE ICE4_SLOW
diff --git a/src/MNH/ice4_warm.f90 b/src/MNH/ice4_warm.f90
index a07d25cd7161608e788dfc9846c60286cec5f395..4862751471f0f9b62a631c1e3ca5529e64c6ba8e 100644
--- a/src/MNH/ice4_warm.f90
+++ b/src/MNH/ice4_warm.f90
@@ -76,6 +76,9 @@ USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XR
USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: X0EVAR,X1EVAR,XCRIAUTC,XEX0EVAR,XEX1EVAR,XEXCACCR,XFCACCR,XTIMAUTC
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MSG
!
#ifdef MNH_BITREP
@@ -123,10 +126,17 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
!
INTEGER :: ISIZE
INTEGER :: JL
+#ifndef MNH_OPENACC
REAL, DIMENSION(:), allocatable :: ZZW2, ZZW3, ZZW4
REAL, DIMENSION(:), allocatable :: ZUSW ! Undersaturation over water
REAL, DIMENSION(:), allocatable :: ZTHLT ! Liquid potential temperature
REAL, DIMENSION(:), allocatable :: ZMASK, ZMASK1, ZMASK2
+#else
+REAL, DIMENSION(:), pointer, contiguous :: ZZW2, ZZW3, ZZW4
+REAL, DIMENSION(:), pointer, contiguous :: ZUSW ! Undersaturation over water
+REAL, DIMENSION(:), pointer, contiguous :: ZTHLT ! Liquid potential temperature
+REAL, DIMENSION(:), pointer, contiguous :: ZMASK, ZMASK1, ZMASK2
+#endif
LOGICAL :: GHSUBG_RR_EVAP ! temporary variable for OpenACC character limitation (Cray CCE)
@@ -169,6 +179,7 @@ END IF
ISIZE = Size( PRHODREF )
+#ifndef MNH_OPENACC
allocate( zzw2 (ISIZE) )
allocate( zzw3 (ISIZE) )
allocate( zzw4 (ISIZE) )
@@ -177,8 +188,21 @@ allocate( zthlt (ISIZE) )
allocate( zmask (ISIZE) )
allocate( zmask1(ISIZE) )
allocate( zmask2(ISIZE) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ICE4_WARM' )
-!$acc data create(ZZW2,ZZW3,ZZW4,ZUSW,ZTHLT,ZMASK,ZMASK1,ZMASK2)
+CALL MNH_MEM_GET( zzw2, isize )
+CALL MNH_MEM_GET( zzw3, isize )
+CALL MNH_MEM_GET( zzw4, isize )
+CALL MNH_MEM_GET( zusw, isize )
+CALL MNH_MEM_GET( zthlt, isize )
+CALL MNH_MEM_GET( zmask, isize )
+CALL MNH_MEM_GET( zmask1, isize )
+CALL MNH_MEM_GET( zmask2, isize )
+
+!$acc data present( ZZW2, ZZW3, ZZW4, ZUSW, ZTHLT, ZMASK, ZMASK1, ZMASK2 )
+#endif
!
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
@@ -246,7 +270,8 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
! => min(PCF, PRF)-PHLC_HCF
- DO JL=1, ISIZE
+!$acc loop independent
+ DO CONCURRENT ( JL = 1 : ISIZE )
ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
&MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
&PCOMPUTE(JL)
@@ -319,25 +344,28 @@ IF (HSUBG_RR_EVAP=='NONE') THEN
ELSE
PRREVAV(:) = 0.
!Evaporation only when there's no cloud (RC must be 0)
- WHERE(ZMASK(:)==1.)
+!$acc loop independent
+ DO CONCURRENT ( JL = 1 : ISIZE )
+ IF ( ZMASK(Jl) == 1. ) THEN
#ifndef MNH_BITREP
- PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
- ! Undersaturation over water
- PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) &
- + ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
- PRREVAV(:) = ( MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) ) * &
- ( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR )
+ PRREVAV(JL) = EXP( XALPW - XBETAW/PT(JL) - XGAMW*ALOG(PT(JL) ) ) ! es_w
+ ZUSW(JL) = 1.0 - PRVT(JL)*( PPRES(JL)-PRREVAV(JL) ) / ( XEPSILO * PRREVAV(JL) )
+ ! Undersaturation over water
+ PRREVAV(JL) = ( XLVTT+(XCPV-XCL)*(PT(JL)-XTT) )**2 / ( PKA(JL)*XRV*PT(JL)**2 ) &
+ + ( XRV*PT(JL) ) / ( PDV(JL)*PRREVAV(JL) )
+ PRREVAV(JL) = ( MAX( 0.0,ZUSW(JL) )/(PRHODREF(JL)*PRREVAV(JL)) ) * &
+ ( X0EVAR*PLBDAR(JL)**XEX0EVAR+X1EVAR*PCJ(JL)*PLBDAR(JL)**XEX1EVAR )
#else
- PRREVAV(:) = BR_EXP( XALPW - XBETAW/PT(:) - XGAMW*BR_LOG(PT(:) ) ) ! es_w
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) )
- ! Undersaturation over water
- PRREVAV(:) = BR_P2( XLVTT+(XCPV-XCL)*(PT(:)-XTT) ) / ( PKA(:)*XRV*BR_P2(PT(:)) ) &
- + ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
- PRREVAV(:) = ( MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) ) * &
- ( X0EVAR*BR_POW(PLBDAR(:),XEX0EVAR)+X1EVAR*PCJ(:)*BR_POW(PLBDAR(:),XEX1EVAR) )
+ PRREVAV(JL) = BR_EXP( XALPW - XBETAW/PT(JL) - XGAMW*BR_LOG(PT(JL) ) ) ! es_w
+ ZUSW(JL) = 1.0 - PRVT(JL)*( PPRES(JL)-PRREVAV(JL) ) / ( (XMV/XMD) * PRREVAV(JL) )
+ ! Undersaturation over water
+ PRREVAV(JL) = BR_P2( XLVTT+(XCPV-XCL)*(PT(JL)-XTT) ) / ( PKA(JL)*XRV*BR_P2(PT(JL)) ) &
+ + ( XRV*PT(JL) ) / ( PDV(JL)*PRREVAV(JL) )
+ PRREVAV(JL) = ( MAX( 0.0,ZUSW(JL) )/(PRHODREF(JL)*PRREVAV(JL)) ) * &
+ ( X0EVAR*BR_POW(PLBDAR(JL),XEX0EVAR)+X1EVAR*PCJ(JL)*BR_POW(PLBDAR(JL),XEX1EVAR) )
#endif
- END WHERE
+ END IF
+ END DO
ENDIF
!$acc end kernels
@@ -363,7 +391,8 @@ IF (HSUBG_RR_EVAP=='CLFR') GHSUBG_RR_EVAP=.true.
!Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
!et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
!On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
- DO JL=1, ISIZE
+!$acc loop independent
+ DO CONCURRENT ( JL = 1 : ISIZE )
ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
&MAX(0., -SIGN(1., PCF(JL)-ZZW4(JL))) * & ! ZZW4(:) > PCF(:)
&PCOMPUTE(JL)
@@ -374,42 +403,45 @@ IF (HSUBG_RR_EVAP=='CLFR') GHSUBG_RR_EVAP=.true.
ENDDO
ELSE
PRREVAV(:) = 0.
- WHERE(ZMASK(:)==1)
- ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
- ! Bechtold et al. 1993
- !
- ! T_l
- ZTHLT(:) = PTHT(:) - XLVTT*PTHT(:)/XCPD/PT(:)*PRCT(:)
- !
- ! T^u = T_l = theta_l * (T/theta)
- ZZW2(:) = ZTHLT(:) * PT(:) / PTHT(:)
- !
- ! es_w with new T^u
+!$acc loop independent
+ DO CONCURRENT ( JL = 1 : ISIZE )
+ IF ( ZMASK(Jl) == 1. ) THEN
+ ! outside the cloud (environment) the use of T^u (unsaturated) instead of T
+ ! Bechtold et al. 1993
+ !
+ ! T_l
+ ZTHLT(JL) = PTHT(JL) - XLVTT*PTHT(JL)/XCPD/PT(JL)*PRCT(JL)
+ !
+ ! T^u = T_l = theta_l * (T/theta)
+ ZZW2(JL) = ZTHLT(JL) * PT(JL) / PTHT(JL)
+ !
+ ! es_w with new T^u
#ifndef MNH_BITREP
- PRREVAV(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
+ PRREVAV(JL) = EXP( XALPW - XBETAW/ZZW2(JL) - XGAMW*ALOG(ZZW2(JL) ) )
#else
- PRREVAV(:) = BR_EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*BR_LOG(ZZW2(:) ) )
+ PRREVAV(JL) = BR_EXP( XALPW - XBETAW/ZZW2(JL) - XGAMW*BR_LOG(ZZW2(JL) ) )
#endif
- !
- ! S, Undersaturation over water (with new theta^u)
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
- !
+ !
+ ! S, Undersaturation over water (with new theta^u)
+ ZUSW(JL) = 1.0 - PRVT(JL)*( PPRES(JL)-PRREVAV(JL) ) / ( XEPSILO * PRREVAV(JL) )
+ !
#ifndef MNH_BITREP
- PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
- + ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) )
- !
- PRREVAV(:) = MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) * &
- ( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR )
+ PRREVAV(JL) = ( XLVTT+(XCPV-XCL)*(ZZW2(JL)-XTT) )**2 / ( PKA(JL)*XRV*ZZW2(JL)**2 ) &
+ + ( XRV*ZZW2(JL) ) / ( PDV(JL)*PRREVAV(JL) )
+ !
+ PRREVAV(JL) = MAX( 0.0,ZUSW(JL) )/(PRHODREF(JL)*PRREVAV(JL)) * &
+ ( X0EVAR*ZZW3(JL)**XEX0EVAR+X1EVAR*PCJ(JL)*ZZW3(JL)**XEX1EVAR )
#else
- PRREVAV(:) = BR_P2( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) ) / ( PKA(:)*XRV*BR_P2(ZZW2(:)) ) &
- + ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) )
- !
- PRREVAV(:) = MAX( 0.0,ZUSW(:) )/(PRHODREF(:)*PRREVAV(:)) * &
- ( X0EVAR*BR_POW(ZZW3(:),XEX0EVAR)+X1EVAR*PCJ(:)*BR_POW(ZZW3(:),XEX1EVAR) )
+ PRREVAV(JL) = BR_P2( XLVTT+(XCPV-XCL)*(ZZW2(JL)-XTT) ) / ( PKA(JL)*XRV*BR_P2(ZZW2(JL)) ) &
+ + ( XRV*ZZW2(JL) ) / ( PDV(JL)*PRREVAV(JL) )
+ !
+ PRREVAV(JL) = MAX( 0.0,ZUSW(JL) )/(PRHODREF(JL)*PRREVAV(JL)) * &
+ ( X0EVAR*BR_POW(ZZW3(JL),XEX0EVAR)+X1EVAR*PCJ(JL)*BR_POW(ZZW3(JL),XEX1EVAR) )
#endif
- !
- PRREVAV(:) = PRREVAV(:)*(ZZW4(:)-PCF(:))
- END WHERE
+ !
+ PRREVAV(JL) = PRREVAV(JL)*(ZZW4(JL)-PCF(JL))
+ END IF
+ END DO
ENDIF
!$acc end kernels
@@ -437,6 +469,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ICE4_WARM' )
+#endif
+
!$acc end data
END SUBROUTINE ICE4_WARM
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index 8da04e62e39528cbc163f6ecb66329684dcf72e6..120f53c81f50692671bd47d5f3c2135151902b17 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -280,6 +280,20 @@ INTEGER :: IKE ! K index value of the last inner mass point
INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
INTEGER :: JI,JJ,JK
!
+#ifndef MNH_OPENACC
+LOGICAL,DIMENSION(:,:,:), allocatable :: GTEMP
+!
+REAL, DIMENSION(:,:,:), allocatable :: ZSIGS,ZSRCS
+REAL, DIMENSION(:,:,:), allocatable &
+ :: ZT, & ! adjusted temperature
+ ZRV, ZRC, ZRI, & ! adjusted state
+ ZCPH, & ! guess of the CPh for the mixing
+ ZLV, & ! guess of the Lv at t+1
+ ZLS, & ! guess of the Ls at t+1
+ ZW1,ZW2, & ! Work arrays for intermediate fields
+ ZCRIAUT, & ! Autoconversion thresholds
+ ZHCF, ZHR
+#else
LOGICAL,DIMENSION(:,:,:), POINTER, CONTIGUOUS :: GTEMP
!
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZSIGS,ZSRCS
@@ -292,6 +306,7 @@ REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS &
ZW1,ZW2, & ! Work arrays for intermediate fields
ZCRIAUT, & ! Autoconversion thresholds
ZHCF, ZHR
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rain_ice_fast_rg.f90 b/src/MNH/rain_ice_fast_rg.f90
index ffb7d664ef9c765ab734d14ffd1065152fc214af..129f0da547a2eeab2bd927e2391b3d3140e9a47d 100644
--- a/src/MNH/rain_ice_fast_rg.f90
+++ b/src/MNH/rain_ice_fast_rg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -44,6 +44,9 @@ use MODD_RAIN_ICE_PARAM, only: NDRYLBDAG, NDRYLBDAR, NDRYLBDAS, X0DEPG, X1DEPG,
XLBRDRYG2, XLBRDRYG3, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XRCFRI
use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifndef MNH_OPENACC
use mode_tools, only: Countjv
@@ -95,6 +98,7 @@ REAL, DIMENSION(:), intent(out) :: PRWETG ! Wet growth rate of the g
!
INTEGER :: IGDRY
INTEGER :: JJ, JL
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), ALLOCATABLE :: I1
INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
@@ -102,6 +106,15 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAR, ZVECLBDAS
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+#else
+INTEGER, DIMENSION(:), pointer, contiguous :: I1
+INTEGER, DIMENSION(:), pointer, contiguous :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(:), pointer, contiguous :: GWORK
+REAL, DIMENSION(:), pointer, contiguous :: ZZW ! Work array
+REAL, DIMENSION(:), pointer, contiguous :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), pointer, contiguous :: ZVECLBDAG, ZVECLBDAR, ZVECLBDAS
+REAL, DIMENSION(:,:), pointer, contiguous :: ZZW1 ! Work arrays
+#endif
!
INTEGER :: JLU
!-------------------------------------------------------------------------------
@@ -162,12 +175,22 @@ END IF
!
JLU = size(PRHODREF)
!
+#ifndef MNH_OPENACC
ALLOCATE( I1 (size(PRHODREF)) )
ALLOCATE( GWORK(size(PRHODREF)) )
ALLOCATE( ZZW (size(PRHODREF)) )
ALLOCATE( ZZW1 (size(PRHODREF),7) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RG 1' )
-!$acc data create( I1, GWORK, ZZW, ZZW1 )
+CALL MNH_MEM_GET( I1, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( GWORK, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( ZZW, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( ZZW1, SIZE(PRHODREF), 7 )
+
+!$acc data present( I1, GWORK, ZZW, ZZW1 )
+#endif
!
!* 6.1 rain contact freezing
@@ -285,6 +308,7 @@ END IF
!
!* 6.2.2 allocations
!
+#ifndef MNH_OPENACC
ALLOCATE(ZVECLBDAG(IGDRY))
ALLOCATE(ZVECLBDAS(IGDRY))
ALLOCATE(ZVEC1(IGDRY))
@@ -292,8 +316,20 @@ END IF
ALLOCATE(ZVEC3(IGDRY))
ALLOCATE(IVEC1(IGDRY))
ALLOCATE(IVEC2(IGDRY))
+#else
+ !Pin positions in the pools of MNH memory
+ CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RG 2' )
-!$acc data create( ZVECLBDAG, ZVECLBDAS, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2 )
+ CALL MNH_MEM_GET( ZVECLBDAG, IGDRY )
+ CALL MNH_MEM_GET( ZVECLBDAS, IGDRY )
+ CALL MNH_MEM_GET( ZVEC1, IGDRY )
+ CALL MNH_MEM_GET( ZVEC2, IGDRY )
+ CALL MNH_MEM_GET( ZVEC3, IGDRY )
+ CALL MNH_MEM_GET( IVEC1, IGDRY )
+ CALL MNH_MEM_GET( IVEC2, IGDRY )
+
+!$acc data present( ZVECLBDAG, ZVECLBDAS, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2 )
+#endif
!
!* 6.2.3 select the (PLBDAG,PLBDAS) couplet
!
@@ -363,6 +399,7 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(ZVEC3,"RAIN_ICE_FAST_RG 6.2.5:ZVEC3")
END IF
!$acc end data
+#ifndef MNH_OPENACC
DEALLOCATE(ZVECLBDAS)
DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
@@ -370,6 +407,10 @@ END IF
DEALLOCATE(ZVEC3)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+#else
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RG 2' )
+#endif
END IF
!
!* 6.2.6 accretion of raindrops on the graupeln
@@ -387,6 +428,7 @@ END IF
!
!* 6.2.7 allocations
!
+#ifndef MNH_OPENACC
ALLOCATE(ZVECLBDAG(IGDRY))
ALLOCATE(ZVECLBDAR(IGDRY))
ALLOCATE(ZVEC1(IGDRY))
@@ -394,7 +436,20 @@ END IF
ALLOCATE(ZVEC3(IGDRY))
ALLOCATE(IVEC1(IGDRY))
ALLOCATE(IVEC2(IGDRY))
-!$acc data create( ZVECLBDAG, ZVECLBDAR, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2 )
+#else
+ !Pin positions in the pools of MNH memory
+ CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RG 3' )
+
+ CALL MNH_MEM_GET( ZVECLBDAG, IGDRY )
+ CALL MNH_MEM_GET( ZVECLBDAR, IGDRY )
+ CALL MNH_MEM_GET( ZVEC1, IGDRY )
+ CALL MNH_MEM_GET( ZVEC2, IGDRY )
+ CALL MNH_MEM_GET( ZVEC3, IGDRY )
+ CALL MNH_MEM_GET( IVEC1, IGDRY )
+ CALL MNH_MEM_GET( IVEC2, IGDRY )
+
+!$acc data present( ZVECLBDAG, ZVECLBDAR, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2 )
+#endif
!
!* 6.2.8 select the (PLBDAG,PLBDAR) couplet
!
@@ -462,6 +517,7 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(ZVEC3,"RAIN_ICE_FAST_RG 6.2.10:ZVEC3")
END IF
!$acc end data
+#ifndef MNH_OPENACC
DEALLOCATE(ZVECLBDAR)
DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
@@ -469,6 +525,10 @@ END IF
DEALLOCATE(ZVEC3)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+#else
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RG 3' )
+#endif
END IF
!
!$acc kernels
@@ -720,6 +780,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RG 1' )
+#endif
+
!$acc end data
END SUBROUTINE RAIN_ICE_FAST_RG
diff --git a/src/MNH/rain_ice_fast_rh.f90 b/src/MNH/rain_ice_fast_rh.f90
index aea0efcc1f0d3842575e220fd0d9b8b36ec143ad..a2d969e71ff3eb5aebc331e8a9dc4af9f9ffc46a 100644
--- a/src/MNH/rain_ice_fast_rh.f90
+++ b/src/MNH/rain_ice_fast_rh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -38,6 +38,9 @@ use MODD_RAIN_ICE_PARAM, only: NWETLBDAG, NWETLBDAH, NWETLBDAS, X0DEPH, X1DEPH,
XWETINTP1G, XWETINTP1H, XWETINTP1S, XWETINTP2G, XWETINTP2H, XWETINTP2S
use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
use mode_msg
#ifndef MNH_OPENACC
@@ -86,6 +89,7 @@ REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over wat
!
INTEGER :: IHAIL, IGWET
INTEGER :: JJ, JL
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), ALLOCATABLE :: I1H, I1W
INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
@@ -93,6 +97,15 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for int
REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAH, ZVECLBDAS
REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+#else
+INTEGER, DIMENSION(:), pointer, contiguous :: I1H, I1W
+INTEGER, DIMENSION(:), pointer, contiguous :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(:), pointer, contiguous :: GWORK
+REAL, DIMENSION(:), pointer, contiguous :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), pointer, contiguous :: ZVECLBDAG, ZVECLBDAH, ZVECLBDAS
+REAL, DIMENSION(:), pointer, contiguous :: ZZW ! Work array
+REAL, DIMENSION(:,:), pointer, contiguous :: ZZW1 ! Work arrays
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -146,13 +159,24 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PUSW,"RAIN_ICE_FAST_RH beg:PUSW")
END IF
!
+#ifndef MNH_OPENACC
ALLOCATE( I1H (size(PRHODREF)) )
ALLOCATE( I1W (size(PRHODREF)) )
ALLOCATE( GWORK(size(PRHODREF)) )
ALLOCATE( ZZW (size(PRHODREF)) )
ALLOCATE( ZZW1 (size(PRHODREF),7) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RH 1' )
-!$acc data create( I1H, I1W, GWORK, ZZW, ZZW1 )
+CALL MNH_MEM_GET( I1H, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( I1W, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( GWORK, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( ZZW, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( ZZW1, SIZE(PRHODREF), 7 )
+
+!$acc data present( I1H, I1W, GWORK, ZZW, ZZW1 )
+#endif
!$acc kernels
GWORK(:) = PRHT(:)>XRTMIN(7)
@@ -218,6 +242,7 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
!
!* 7.2.2 allocations
!
+#ifndef MNH_OPENACC
ALLOCATE(ZVECLBDAH(IGWET))
ALLOCATE(ZVECLBDAS(IGWET))
ALLOCATE(ZVEC1(IGWET))
@@ -225,9 +250,20 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
ALLOCATE(ZVEC3(IGWET))
ALLOCATE(IVEC1(IGWET))
ALLOCATE(IVEC2(IGWET))
+#else
+ !Pin positions in the pools of MNH memory
+ CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RG 2' )
-!$acc data create( ZVECLBDAH, ZVECLBDAS, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2 )
+ CALL MNH_MEM_GET( ZVECLBDAH, IGWET )
+ CALL MNH_MEM_GET( ZVECLBDAS, IGWET )
+ CALL MNH_MEM_GET( ZVEC1, IGWET )
+ CALL MNH_MEM_GET( ZVEC2, IGWET )
+ CALL MNH_MEM_GET( ZVEC3, IGWET )
+ CALL MNH_MEM_GET( IVEC1, IGWET )
+ CALL MNH_MEM_GET( IVEC2, IGWET )
+!$acc data present( ZVECLBDAH, ZVECLBDAS, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2 )
+#endif
!
!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
!
@@ -275,6 +311,7 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
!$acc end kernels
!$acc end data
+#ifndef MNH_OPENACC
DEALLOCATE(ZVECLBDAS)
DEALLOCATE(ZVECLBDAH)
DEALLOCATE(IVEC2)
@@ -282,6 +319,10 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
DEALLOCATE(ZVEC3)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+#else
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RH 2' )
+#endif
END IF
!
!* 7.2.6 accretion of graupeln on the hailstones
@@ -299,6 +340,7 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
!
!* 7.2.7 allocations
!
+#ifndef MNH_OPENACC
ALLOCATE(ZVECLBDAG(IGWET))
ALLOCATE(ZVECLBDAH(IGWET))
ALLOCATE(ZVEC1(IGWET))
@@ -306,8 +348,20 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
ALLOCATE(ZVEC3(IGWET))
ALLOCATE(IVEC1(IGWET))
ALLOCATE(IVEC2(IGWET))
+#else
+ !Pin positions in the pools of MNH memory
+ CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RH 3' )
+
+ CALL MNH_MEM_GET( ZVECLBDAG, IGWET )
+ CALL MNH_MEM_GET( ZVECLBDAH, IGWET )
+ CALL MNH_MEM_GET( ZVEC1, IGWET )
+ CALL MNH_MEM_GET( ZVEC2, IGWET )
+ CALL MNH_MEM_GET( ZVEC3, IGWET )
+ CALL MNH_MEM_GET( IVEC1, IGWET )
+ CALL MNH_MEM_GET( IVEC2, IGWET )
-!$acc data create( ZVECLBDAG, ZVECLBDAH, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2 )
+!$acc data present( ZVECLBDAG, ZVECLBDAH, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2 )
+#endif
!
!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
!
@@ -355,6 +409,7 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
!$acc end kernels
!$acc end data
+#ifndef MNH_OPENACC
DEALLOCATE(ZVECLBDAH)
DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
@@ -362,6 +417,10 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
DEALLOCATE(ZVEC3)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+#else
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RH 3' )
+#endif
END IF
!
!* 7.3 compute the Wet growth of hail
@@ -511,6 +570,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RH 1' )
+#endif
+
!$acc end data
END SUBROUTINE RAIN_ICE_FAST_RH
diff --git a/src/MNH/rain_ice_fast_ri.f90 b/src/MNH/rain_ice_fast_ri.f90
index 359c31e8a92246e442e3f18aef4d694cb2b9736d..f27f0edeefffda6a3fa02ef699ba65c66bcb30eb 100644
--- a/src/MNH/rain_ice_fast_ri.f90
+++ b/src/MNH/rain_ice_fast_ri.f90
@@ -32,6 +32,9 @@ use MODD_RAIN_ICE_DESCR, only: XDI, XLBEXI, XLBI, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0DEPI, X2DEPI
use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_BITREP
@@ -59,9 +62,15 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
!
!* 0.2 declaration of local variables
!
+#ifndef MNH_OPENACC
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
REAL, DIMENSION(:), ALLOCATABLE :: ZLBEXI
+#else
+LOGICAL, DIMENSION(:), pointer, contiguous :: GWORK
+REAL, DIMENSION(:), pointer, contiguous :: ZZW ! Work array
+REAL, DIMENSION(:), pointer, contiguous :: ZLBEXI
+#endif
!
INTEGER :: JL,JLU
!-------------------------------------------------------------------------------
@@ -101,11 +110,20 @@ END IF
!
JLU = size(PRHODREF)
!
+#ifndef MNH_OPENACC
ALLOCATE( GWORK(size(PRHODREF)) )
ALLOCATE( ZZW (size(PRHODREF)) )
ALLOCATE( ZLBEXI (size(PRHODREF)) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RI' )
-!$acc data create( GWORK, ZZW , ZLBEXI )
+CALL MNH_MEM_GET( GWORK, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( ZZW, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( ZLBEXI, SIZE(PRHODREF) )
+
+!$acc data present( GWORK, ZZW , ZLBEXI )
+#endif
!
!* 7.1 cloud ice melting
@@ -192,6 +210,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RI' )
+#endif
+
!$acc end data
END SUBROUTINE RAIN_ICE_FAST_RI
diff --git a/src/MNH/rain_ice_fast_rs.f90 b/src/MNH/rain_ice_fast_rs.f90
index bcd3400ca186c6d6e1acd6999e69d51506328749..fae5552bd0e15a5d12cd1046ec1f246d4f8c738b 100644
--- a/src/MNH/rain_ice_fast_rs.f90
+++ b/src/MNH/rain_ice_fast_rs.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -43,6 +43,9 @@ use MODD_RAIN_ICE_PARAM, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XA
XRIMINTP1, XRIMINTP2, XSRIMCG
use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifndef MNH_OPENACC
use mode_tools, only: Countjv
@@ -86,6 +89,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
!
INTEGER :: IGRIM, IGACC
INTEGER :: JJ, JL
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), ALLOCATABLE :: I1
INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
@@ -93,6 +97,15 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAR, ZVECLBDAS
REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
+#else
+INTEGER, DIMENSION(:), pointer, contiguous :: I1
+INTEGER, DIMENSION(:), pointer, contiguous :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(:), pointer, contiguous :: GWORK
+REAL, DIMENSION(:), pointer, contiguous :: ZZW ! Work array
+REAL, DIMENSION(:), pointer, contiguous :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), pointer, contiguous :: ZVECLBDAR, ZVECLBDAS
+REAL, DIMENSION(:), pointer, contiguous :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
+#endif
!
INTEGER :: JJU
!
@@ -145,13 +158,22 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(XKER_RACCSS,"RAIN_ICE_FAST_RS beg:XKER_RACCSS")
END IF
!
+#ifndef MNH_OPENACC
ALLOCATE( I1 (size(PRHODREF)) )
ALLOCATE( GWORK(size(PRHODREF)) )
ALLOCATE( ZZW (size(PRHODREF)) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RS 1' )
-JJU = size(PRHODREF)
+CALL MNH_MEM_GET( I1, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( GWORK, SIZE(PRHODREF) )
+CALL MNH_MEM_GET( ZZW, SIZE(PRHODREF) )
-!$acc data create( I1, GWORK, ZZW )
+!$acc data present( I1, GWORK, ZZW )
+#endif
+
+JJU = size(PRHODREF)
!
!* 5.1 cloud droplet riming of the aggregates
!
@@ -177,6 +199,7 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
!
! 5.1.0 allocations
!
+#ifndef MNH_OPENACC
ALLOCATE(ZVECLBDAS(IGRIM))
ALLOCATE(ZVEC1(IGRIM))
ALLOCATE(ZVEC2(IGRIM))
@@ -184,7 +207,20 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
ALLOCATE(ZZW1(IGRIM))
ALLOCATE(ZZW2(IGRIM))
ALLOCATE(ZZW3(IGRIM))
-!$acc data create( ZVECLBDAS, ZVEC1, ZVEC2, IVEC2, ZZW1, ZZW2, ZZW3 )
+#else
+ !Pin positions in the pools of MNH memory
+ CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RS 2' )
+
+ CALL MNH_MEM_GET( ZVECLBDAS, IGRIM )
+ CALL MNH_MEM_GET( ZVEC1, IGRIM )
+ CALL MNH_MEM_GET( ZVEC2, IGRIM )
+ CALL MNH_MEM_GET( IVEC2, IGRIM )
+ CALL MNH_MEM_GET( ZZW1, IGRIM )
+ CALL MNH_MEM_GET( ZZW2, IGRIM )
+ CALL MNH_MEM_GET( ZZW3, IGRIM )
+
+!$acc data present( ZVECLBDAS, ZVEC1, ZVEC2, IVEC2, ZZW1, ZZW2, ZZW3 )
+#endif
!
! 5.1.1 select the PLBDAS
!
@@ -308,6 +344,7 @@ END IF
if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', Unpack ( prgs(:) * prhodj(:), &
mask = omicro(:,:,:), field = 0. ) )
+#ifndef MNH_OPENACC
DEALLOCATE(ZZW3)
DEALLOCATE(ZZW2)
DEALLOCATE(ZZW1)
@@ -315,6 +352,10 @@ END IF
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
DEALLOCATE(ZVECLBDAS)
+#else
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RS 2' )
+#endif
END IF
!
!* 5.2 rain accretion onto the aggregates
@@ -340,6 +381,7 @@ END IF
!
! 5.2.0 allocations
!
+#ifndef MNH_OPENACC
ALLOCATE(ZVECLBDAR(IGACC))
ALLOCATE(ZVECLBDAS(IGACC))
ALLOCATE(ZVEC1(IGACC))
@@ -350,7 +392,23 @@ END IF
ALLOCATE(ZZW2(IGACC))
ALLOCATE(ZZW3(IGACC))
ALLOCATE(ZZW4(IGACC))
-!$acc data create( ZVECLBDAR, ZVECLBDAS, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2, ZZW2, ZZW3, ZZW4 )
+#else
+ !Pin positions in the pools of MNH memory
+ CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_FAST_RS 3' )
+
+ CALL MNH_MEM_GET( ZVECLBDAR, IGACC )
+ CALL MNH_MEM_GET( ZVECLBDAS, IGACC )
+ CALL MNH_MEM_GET( ZVEC1, IGACC )
+ CALL MNH_MEM_GET( ZVEC2, IGACC )
+ CALL MNH_MEM_GET( ZVEC3, IGACC )
+ CALL MNH_MEM_GET( IVEC1, IGACC )
+ CALL MNH_MEM_GET( IVEC2, IGACC )
+ CALL MNH_MEM_GET( ZZW2, IGACC )
+ CALL MNH_MEM_GET( ZZW3, IGACC )
+ CALL MNH_MEM_GET( ZZW4, IGACC )
+
+!$acc data present( ZVECLBDAR, ZVECLBDAS, ZVEC1, ZVEC2, ZVEC3, IVEC1, IVEC2, ZZW2, ZZW3, ZZW4 )
+#endif
!
! 5.2.1 select the (PLBDAS,PLBDAR) couplet
!
@@ -503,6 +561,7 @@ END IF
if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', Unpack ( prgs(:) * prhodj(:), &
mask = omicro(:,:,:), field = 0. ) )
+#ifndef MNH_OPENACC
DEALLOCATE(ZZW4)
DEALLOCATE(ZZW3)
DEALLOCATE(ZZW2)
@@ -513,6 +572,10 @@ END IF
DEALLOCATE(ZVEC1)
DEALLOCATE(ZVECLBDAS)
DEALLOCATE(ZVECLBDAR)
+#else
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RS 3' )
+#endif
END IF
!
!* 5.3 Conversion-Melting of the aggregates
@@ -567,6 +630,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'RAIN_ICE_FAST_RS 1' )
+#endif
+
!$acc end data
END SUBROUTINE RAIN_ICE_FAST_RS
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index 08462db53099c8bd7552cf5af7230936eeceabc4..ed80a9ede73f31940e20e42ae0108dbefc2f255c 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -277,6 +277,9 @@ USE MODD_VAR_ll, ONLY: IP
use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
USE MODE_MPPDB
USE MODE_MSG
use mode_tools, only: Countjv
@@ -367,6 +370,7 @@ INTEGER :: IKE, IKTE !
!
INTEGER :: IDX, JI, JJ, JK
INTEGER :: IMICRO ! Case r_x>0 locations
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), allocatable :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
@@ -519,6 +523,160 @@ REAL, DIMENSION(:), allocatable :: ZSSI
!For total tendencies computation
REAL, DIMENSION(:,:,:), allocatable :: &
&ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS
+#else
+INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!Arrays for nucleation call outisde of ODMICRO points
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZW ! work array
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZT ! Temperature
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: &
+ & ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ & ZZ_RVHENI ! heterogeneous nucleation
+real, dimension(:,:,:), POINTER, CONTIGUOUS :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
+real, dimension(:,:,:), POINTER, CONTIGUOUS :: zz_diff
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D
+!
+!Diagnostics
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: &
+ & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
+ & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
+ & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
+ & ZHLC_LRC3D,& ! HLCLOUDS cloud water content in low water content
+ & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
+ & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
+ & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
+ & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
+
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZINPRI ! Pristine ice instant precip
+!
+!Packed variables
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRVT, & ! Water vapor m.r. at t
+ ZRCT, & ! Cloud water m.r. at t
+ ZRRT, & ! Rain water m.r. at t
+ ZRIT, & ! Pristine ice m.r. at t
+ ZRST, & ! Snow/aggregate m.r. at t
+ ZRGT, & ! Graupel m.r. at t
+ ZRHT, & ! Hail m.r. at t
+ ZCIT, & ! Pristine ice conc. at t
+ ZTHT, & ! Potential temperature
+ ZRHODREF, & ! RHO Dry REFerence
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXN, & ! EXNer Pressure
+ ZLSFACT, & ! L_s/(Pi*C_ph)
+ ZLVFACT, & ! L_v/(Pi*C_ph)
+ ZSIGMA_RC,& ! Standard deviation of rc at time t
+ ZCF, & ! Cloud fraction
+ ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
+ ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that ZCF = ZHLC_HCF + ZHLC_LCF
+ ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
+ ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that ZRC = ZHLC_HRC + ZHLC_LRC
+ ZHLI_HCF, &
+ ZHLI_LCF, &
+ ZHLI_HRI, &
+ ZHLI_LRI
+!
+!Output packed tendencies (for budgets only)
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ ZRCHONI, & ! Homogeneous nucleation
+ ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
+ ZRVDEPS, & ! Deposition on r_s,
+ ZRIAGGS, & ! Aggregation on r_s
+ ZRIAUTS, & ! Autoconversion of r_i for r_s production
+ ZRVDEPG, & ! Deposition on r_g
+ ZRCAUTR, & ! Autoconversion of r_c for r_r production
+ ZRCACCR, & ! Accretion of r_c for r_r production
+ ZRREVAV, & ! Evaporation of r_r
+ ZRIMLTC_MR, & ! Cloud ice melting mixing ratio change
+ ZRCBERI, & ! Bergeron-Findeisen effect
+ ZRHMLTR, & ! Melting of the hailstones
+ ZRSMLTG, & ! Conversion-Melting of the aggregates
+ ZRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ ZRRACCSS, ZRRACCSG, ZRSACCRG, & ! Rain accretion onto the aggregates
+ ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, & ! Cloud droplet riming of the aggregates
+ ZRICFRRG, ZRRCFRIG, ZRICFRR, & ! Rain contact freezing
+ ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, & ! Graupel wet growth
+ ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, & ! Graupel dry growth
+ ZRWETGH, & ! Conversion of graupel into hail
+ ZRWETGH_MR, & ! Conversion of graupel into hail, mr change
+ ZRGMLTR, & ! Melting of the graupel
+ ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, & ! Dry growth of hailstone
+ ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
+ ZRDRYHG ! Conversion of hailstone into graupel
+!
+!Output packed total mixing ratio change (for budgets only)
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
+ ZTOT_RCHONI, & ! Homogeneous nucleation
+ ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
+ ZTOT_RVDEPS, & ! Deposition on r_s,
+ ZTOT_RIAGGS, & ! Aggregation on r_s
+ ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
+ ZTOT_RVDEPG, & ! Deposition on r_g
+ ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
+ ZTOT_RCACCR, & ! Accretion of r_c for r_r production
+ ZTOT_RREVAV, & ! Evaporation of r_r
+ ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
+ ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
+ ZTOT_RCBERI, & ! Bergeron-Findeisen effect
+ ZTOT_RHMLTR, & ! Melting of the hailstones
+ ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
+ ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
+ ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
+ ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
+ ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
+ ZTOT_RWETGH, & ! Conversion of graupel into hail
+ ZTOT_RGMLTR, & ! Melting of the graupel
+ ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
+ ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
+ ZTOT_RDRYHG ! Conversion of hailstone into graupel
+!
+!For time- or mixing-ratio- splitting
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
+ Z0RCT, & ! Cloud water m.r. at the beginig of the current loop
+ Z0RRT, & ! Rain water m.r. at the beginig of the current loop
+ Z0RIT, & ! Pristine ice m.r. at the beginig of the current loop
+ Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
+ Z0RGT, & ! Graupel m.r. at the beginig of the current loop
+ Z0RHT, & ! Hail m.r. at the beginig of the current loop
+ ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
+ ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH
+!
+!To take into acount external tendencies inside the splitting
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZEXT_RV, & ! External tendencie for rv
+ ZEXT_RC, & ! External tendencie for rc
+ ZEXT_RR, & ! External tendencie for rr
+ ZEXT_RI, & ! External tendencie for ri
+ ZEXT_RS, & ! External tendencie for rs
+ ZEXT_RG, & ! External tendencie for rg
+ ZEXT_RH, & ! External tendencie for rh
+ ZEXT_TH ! External tendencie for th
+LOGICAL :: GEXT_TEND
+!
+INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: IITER ! Number of iterations done (with real tendencies computation)
+INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
+ ZMAXTIME, & ! Time on which we can apply the current tendencies
+ ZTIME_THRESHOLD, & ! Time to reach threshold
+ ZTIME_LASTCALL ! Integration time when last tendecies call has been done
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZW1D
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZCOMPUTE ! Points where we must compute tendenceis
+LOGICAL :: GSOFT ! Must we really compute tendencies or only adjust them to new T variables
+LOGICAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: GDNOTMICRO ! = .NOT.ODMICRO
+REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
+REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZRS_TEND
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZRG_TEND
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZRH_TEND
+REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZSSI
+!
+!For total tendencies computation
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: &
+ &ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS
+#endif
!
LOGICAL :: GTEST ! temporary variable for OpenACC character limitation (Cray CCE)
@@ -571,6 +729,7 @@ END IF
imicro = count(odmicro)
!$acc end kernels
+#ifndef MNH_OPENACC
allocate( i1(imicro ) )
allocate( i2(imicro ) )
allocate( i3(imicro ) )
@@ -774,8 +933,215 @@ allocate( zw_rss(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rgs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rhs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_ths(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-
-!$acc data create( I1, I2, I3, &
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( i1, imicro )
+CALL MNH_MEM_GET( i2, imicro )
+CALL MNH_MEM_GET( i3, imicro )
+
+CALL MNH_MEM_GET( zw, size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) )
+CALL MNH_MEM_GET( zt, size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) )
+
+CALL MNH_MEM_GET( zz_rvheni_mr, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zz_rvheni, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zz_lvfact, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zz_lsfact, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zlsfact3d, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+
+CALL MNH_MEM_GET( ZHLC_HCF3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( ZHLC_LCF3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( ZHLC_HRC3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( ZHLC_LRC3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( ZHLI_HCF3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( ZHLI_LCF3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( ZHLI_HRI3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( ZHLI_LRI3D, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+
+CALL MNH_MEM_GET( zinpri, size( ptht, 1 ), size( ptht, 2 ) )
+
+CALL MNH_MEM_GET( zrvt , imicro )
+CALL MNH_MEM_GET( zrct , imicro )
+CALL MNH_MEM_GET( zrrt , imicro )
+CALL MNH_MEM_GET( zrit , imicro )
+CALL MNH_MEM_GET( zrst , imicro )
+CALL MNH_MEM_GET( zrgt , imicro )
+CALL MNH_MEM_GET( zrht , imicro )
+CALL MNH_MEM_GET( zcit , imicro )
+CALL MNH_MEM_GET( ztht , imicro )
+CALL MNH_MEM_GET( zrhodref , imicro )
+CALL MNH_MEM_GET( zzt , imicro )
+CALL MNH_MEM_GET( zpres , imicro )
+CALL MNH_MEM_GET( zexn , imicro )
+CALL MNH_MEM_GET( zlsfact , imicro )
+CALL MNH_MEM_GET( zlvfact , imicro )
+CALL MNH_MEM_GET( zsigma_rc, imicro )
+CALL MNH_MEM_GET( zcf , imicro )
+CALL MNH_MEM_GET( zhlc_hcf , imicro )
+CALL MNH_MEM_GET( zhlc_lcf , imicro )
+CALL MNH_MEM_GET( zhlc_hrc , imicro )
+CALL MNH_MEM_GET( zhlc_lrc , imicro )
+CALL MNH_MEM_GET( ZHLI_HCF , imicro )
+CALL MNH_MEM_GET( ZHLI_LCF , imicro )
+CALL MNH_MEM_GET( ZHLI_HRI , imicro )
+CALL MNH_MEM_GET( ZHLI_LRI , imicro )
+
+CALL MNH_MEM_GET( zrvheni_mr , imicro )
+CALL MNH_MEM_GET( zrchoni , imicro )
+CALL MNH_MEM_GET( zrrhong_mr , imicro )
+CALL MNH_MEM_GET( zrvdeps , imicro )
+CALL MNH_MEM_GET( zriaggs , imicro )
+CALL MNH_MEM_GET( zriauts , imicro )
+CALL MNH_MEM_GET( zrvdepg , imicro )
+CALL MNH_MEM_GET( zrcautr , imicro )
+CALL MNH_MEM_GET( zrcaccr , imicro )
+CALL MNH_MEM_GET( zrrevav , imicro )
+CALL MNH_MEM_GET( zrimltc_mr , imicro )
+CALL MNH_MEM_GET( zrcberi , imicro )
+CALL MNH_MEM_GET( zrhmltr , imicro )
+CALL MNH_MEM_GET( zrsmltg , imicro )
+CALL MNH_MEM_GET( zrcmltsr , imicro )
+CALL MNH_MEM_GET( zrraccss , imicro )
+CALL MNH_MEM_GET( zrraccsg , imicro )
+CALL MNH_MEM_GET( zrsaccrg , imicro )
+CALL MNH_MEM_GET( zrcrimss , imicro )
+CALL MNH_MEM_GET( zrcrimsg , imicro )
+CALL MNH_MEM_GET( zrsrimcg , imicro )
+CALL MNH_MEM_GET( zrsrimcg_mr, imicro )
+CALL MNH_MEM_GET( zricfrrg , imicro )
+CALL MNH_MEM_GET( zrrcfrig , imicro )
+CALL MNH_MEM_GET( zricfrr , imicro )
+CALL MNH_MEM_GET( zrcwetg , imicro )
+CALL MNH_MEM_GET( zriwetg , imicro )
+CALL MNH_MEM_GET( zrrwetg , imicro )
+CALL MNH_MEM_GET( zrswetg , imicro )
+CALL MNH_MEM_GET( zrcdryg , imicro )
+CALL MNH_MEM_GET( zridryg , imicro )
+CALL MNH_MEM_GET( zrrdryg , imicro )
+CALL MNH_MEM_GET( zrsdryg , imicro )
+CALL MNH_MEM_GET( zrwetgh , imicro )
+CALL MNH_MEM_GET( zrwetgh_mr , imicro )
+CALL MNH_MEM_GET( zrgmltr , imicro )
+CALL MNH_MEM_GET( zrcweth , imicro )
+CALL MNH_MEM_GET( zriweth , imicro )
+CALL MNH_MEM_GET( zrsweth , imicro )
+CALL MNH_MEM_GET( zrgweth , imicro )
+CALL MNH_MEM_GET( zrrweth , imicro )
+CALL MNH_MEM_GET( zrcdryh , imicro )
+CALL MNH_MEM_GET( zridryh , imicro )
+CALL MNH_MEM_GET( zrsdryh , imicro )
+CALL MNH_MEM_GET( zrrdryh , imicro )
+CALL MNH_MEM_GET( zrgdryh , imicro )
+CALL MNH_MEM_GET( zrdryhg , imicro )
+
+CALL MNH_MEM_GET( ztot_rvheni , imicro )
+CALL MNH_MEM_GET( ztot_rchoni , imicro )
+CALL MNH_MEM_GET( ztot_rrhong , imicro )
+CALL MNH_MEM_GET( ztot_rvdeps , imicro )
+CALL MNH_MEM_GET( ztot_riaggs , imicro )
+CALL MNH_MEM_GET( ztot_riauts , imicro )
+CALL MNH_MEM_GET( ztot_rvdepg , imicro )
+CALL MNH_MEM_GET( ztot_rcautr , imicro )
+CALL MNH_MEM_GET( ztot_rcaccr , imicro )
+CALL MNH_MEM_GET( ztot_rrevav , imicro )
+CALL MNH_MEM_GET( ztot_rcrimss, imicro )
+CALL MNH_MEM_GET( ztot_rcrimsg, imicro )
+CALL MNH_MEM_GET( ztot_rsrimcg, imicro )
+CALL MNH_MEM_GET( ztot_rimltc , imicro )
+CALL MNH_MEM_GET( ztot_rcberi , imicro )
+CALL MNH_MEM_GET( ztot_rhmltr , imicro )
+CALL MNH_MEM_GET( ztot_rsmltg , imicro )
+CALL MNH_MEM_GET( ztot_rcmltsr, imicro )
+CALL MNH_MEM_GET( ztot_rraccss, imicro )
+CALL MNH_MEM_GET( ztot_rraccsg, imicro )
+CALL MNH_MEM_GET( ztot_rsaccrg, imicro )
+CALL MNH_MEM_GET( ztot_ricfrrg, imicro )
+CALL MNH_MEM_GET( ztot_rrcfrig, imicro )
+CALL MNH_MEM_GET( ztot_ricfrr , imicro )
+CALL MNH_MEM_GET( ztot_rcwetg , imicro )
+CALL MNH_MEM_GET( ztot_riwetg , imicro )
+CALL MNH_MEM_GET( ztot_rrwetg , imicro )
+CALL MNH_MEM_GET( ztot_rswetg , imicro )
+CALL MNH_MEM_GET( ztot_rcdryg , imicro )
+CALL MNH_MEM_GET( ztot_ridryg , imicro )
+CALL MNH_MEM_GET( ztot_rrdryg , imicro )
+CALL MNH_MEM_GET( ztot_rsdryg , imicro )
+CALL MNH_MEM_GET( ztot_rwetgh , imicro )
+CALL MNH_MEM_GET( ztot_rgmltr , imicro )
+CALL MNH_MEM_GET( ztot_rcweth , imicro )
+CALL MNH_MEM_GET( ztot_riweth , imicro )
+CALL MNH_MEM_GET( ztot_rsweth , imicro )
+CALL MNH_MEM_GET( ztot_rgweth , imicro )
+CALL MNH_MEM_GET( ztot_rrweth , imicro )
+CALL MNH_MEM_GET( ztot_rcdryh , imicro )
+CALL MNH_MEM_GET( ztot_rdryhg , imicro )
+CALL MNH_MEM_GET( ztot_ridryh , imicro )
+CALL MNH_MEM_GET( ztot_rsdryh , imicro )
+CALL MNH_MEM_GET( ztot_rrdryh , imicro )
+CALL MNH_MEM_GET( ztot_rgdryh , imicro )
+
+CALL MNH_MEM_GET( z0rvt, imicro )
+CALL MNH_MEM_GET( z0rct, imicro )
+CALL MNH_MEM_GET( z0rrt, imicro )
+CALL MNH_MEM_GET( z0rit, imicro )
+CALL MNH_MEM_GET( z0rst, imicro )
+CALL MNH_MEM_GET( z0rgt, imicro )
+CALL MNH_MEM_GET( z0rht, imicro )
+CALL MNH_MEM_GET( za_th, imicro )
+CALL MNH_MEM_GET( za_rv, imicro )
+CALL MNH_MEM_GET( za_rc, imicro )
+CALL MNH_MEM_GET( za_rr, imicro )
+CALL MNH_MEM_GET( za_ri, imicro )
+CALL MNH_MEM_GET( za_rs, imicro )
+CALL MNH_MEM_GET( za_rg, imicro )
+CALL MNH_MEM_GET( za_rh, imicro )
+CALL MNH_MEM_GET( zb_th, imicro )
+CALL MNH_MEM_GET( zb_rv, imicro )
+CALL MNH_MEM_GET( zb_rc, imicro )
+CALL MNH_MEM_GET( zb_rr, imicro )
+CALL MNH_MEM_GET( zb_ri, imicro )
+CALL MNH_MEM_GET( zb_rs, imicro )
+CALL MNH_MEM_GET( zb_rg, imicro )
+CALL MNH_MEM_GET( zb_rh, imicro )
+
+CALL MNH_MEM_GET( zext_rv, imicro )
+CALL MNH_MEM_GET( zext_rc, imicro )
+CALL MNH_MEM_GET( zext_rr, imicro )
+CALL MNH_MEM_GET( zext_ri, imicro )
+CALL MNH_MEM_GET( zext_rs, imicro )
+CALL MNH_MEM_GET( zext_rg, imicro )
+CALL MNH_MEM_GET( zext_rh, imicro )
+CALL MNH_MEM_GET( zext_th, imicro )
+
+CALL MNH_MEM_GET( iiter, imicro )
+
+CALL MNH_MEM_GET( ztime, imicro )
+CALL MNH_MEM_GET( zmaxtime, imicro )
+CALL MNH_MEM_GET( ztime_threshold, imicro )
+CALL MNH_MEM_GET( ztime_lastcall, imicro )
+
+CALL MNH_MEM_GET( zw1d, imicro )
+CALL MNH_MEM_GET( zcompute, imicro )
+
+CALL MNH_MEM_GET( gdnotmicro, size( odmicro, 1 ), size( odmicro, 2 ), size( odmicro, 3 ) )
+
+CALL MNH_MEM_GET( zrs_tend, imicro, 8 )
+CALL MNH_MEM_GET( zrg_tend, imicro, 8 )
+CALL MNH_MEM_GET( zrh_tend, imicro, 10 )
+
+CALL MNH_MEM_GET( zssi, imicro )
+
+CALL MNH_MEM_GET( zw_rvs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zw_rcs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zw_rrs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zw_ris, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zw_rss, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zw_rgs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zw_rhs, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+CALL MNH_MEM_GET( zw_ths, size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) )
+
+!$acc data present( I1, I2, I3, &
!$acc & ZW, ZT, ZZ_RVHENI_MR, ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D, ZINPRI, &
!$acc & ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, ZCIT, ZTHT, ZRHODREF, ZZT, ZPRES, ZEXN, &
!$acc & ZLSFACT, ZLVFACT, &
@@ -799,6 +1165,7 @@ allocate( zw_ths(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
!$acc & ZEXT_RV, ZEXT_RC, ZEXT_RR, ZEXT_RI, ZEXT_RS, ZEXT_RG, ZEXT_RH, ZEXT_TH, &
!$acc & IITER, ZTIME, ZMAXTIME, ZTIME_THRESHOLD, ZTIME_LASTCALL, ZW1D, ZCOMPUTE, GDNOTMICRO, &
!$acc & ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS )
+#endif
!-------------------------------------------------------------------------------
if ( lbu_enable ) then
@@ -844,6 +1211,7 @@ ZRCBERI(:) = 0.
!
! LSFACT and LVFACT without exner
IF(KRR==7) THEN
+!$acc loop independent collapse(3)
DO JK = 1, KKT
DO JJ = 1, KJT
DO JI = 1, KIT
@@ -858,6 +1226,7 @@ IF(KRR==7) THEN
ENDDO
ENDDO
ELSE
+!$acc loop independent collapse(3)
DO JK = 1, KKT
DO JJ = 1, KJT
DO JI = 1, KIT
@@ -996,6 +1365,7 @@ GTEST=.false.
IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') GTEST=.true.
!$acc kernels
IF(IMICRO>0) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
@@ -1027,6 +1397,7 @@ IF(IMICRO>0) THEN
ENDIF
ENDDO
IF(GEXT_TEND) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZEXT_RV(JL) = PRVS(I1(JL),I2(JL),I3(JL)) - ZRVT(JL)*ZINV_TSTEP
ZEXT_RC(JL) = PRCS(I1(JL),I2(JL),I3(JL)) - ZRCT(JL)*ZINV_TSTEP
@@ -1040,6 +1411,7 @@ IF(IMICRO>0) THEN
ENDIF
!IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') THEN
IF (GTEST) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL))*2.
ENDDO
@@ -1047,10 +1419,12 @@ IF(IMICRO>0) THEN
ZSIGMA_RC(:) = XUNDEF
ENDIF
IF(KRR==7) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
ENDDO
IF(GEXT_TEND) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZEXT_RH(JL) = PRHS(I1(JL),I2(JL),I3(JL)) - ZRHT(JL)*ZINV_TSTEP
ENDDO
@@ -1152,12 +1526,16 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
!$acc kernels
ZCOMPUTE(:)=MAX(0., -SIGN(1., ZTIME(:)-PTSTEP)) ! Compuation (1.) only for points for which integration time has not reached the timestep
GSOFT=.FALSE. ! We *really* compute the tendencies
- IITER(:)=IITER(:)+INT(ZCOMPUTE(:))
+!$acc loop independent
+ DO JL = 1, IMICRO
+ IITER(JL) = IITER(JL) + INT( ZCOMPUTE(JL) )
+ END DO
!$acc end kernels
!$acc update self(ZCOMPUTE)
DO WHILE(SUM(ZCOMPUTE(:))>0.) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
!$acc kernels
IF(KRR==7) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZZT(JL) = ZTHT(JL) * ZEXN(JL)
ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
@@ -1168,6 +1546,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
&+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
ENDDO
ELSE
+!$acc loop independent
DO JL=1, IMICRO
ZZT(JL) = ZTHT(JL) * ZEXN(JL)
ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
@@ -1209,6 +1588,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
! External tendencies
!$acc kernels
IF(GEXT_TEND) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZA_TH(JL) = ZA_TH(JL) + ZEXT_TH(JL)
ZA_RV(JL) = ZA_RV(JL) + ZEXT_RV(JL)
@@ -1228,6 +1608,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
!We need to adjust tendencies when temperature reaches 0
IF(LFEEDBACKT) THEN
+!$acc loop independent
DO JL=1, IMICRO
!Is ZB_TH enough to change temperature sign?
ZW1D(JL)=(ZTHT(JL) - XTT/ZEXN(JL)) * (ZTHT(JL) + ZB_TH(JL) - XTT/ZEXN(JL))
@@ -1245,6 +1626,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
ENDIF
!We need to adjust tendencies when a specy disappears
!When a species is missing, only the external tendencies can be negative (and we must keep track of it)
+!$acc loop independent
DO JL=1, IMICRO
ZW1D(JL)=MAX(0., -SIGN(1., ZA_RV(JL)+1.E-20)) * & ! WHERE(ZA_RV(:)<-1.E-20)
&MAX(0., -SIGN(1., XRTMIN(1)-ZRVT(JL))) ! WHERE(ZRVT(:)>XRTMIN(1))
@@ -1278,6 +1660,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
ENDDO
IF(KRR==7) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZW1D(JL)=MAX(0., -SIGN(1., ZA_RH(JL)+1.E-20)) * & ! WHERE(ZA_RH(:)<-1.E-20)
&MAX(0., -SIGN(1., XRTMIN(7)-ZRHT(JL))) ! WHERE(ZRHT(:)>XRTMIN(7))
@@ -1290,6 +1673,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
!We must recompute tendencies when the end of the sub-timestep is reached
IF(XTSTEP_TS/=0.) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
&MAX(0., -SIGN(1., ZTIME_LASTCALL(JL)+ZTSTEP-ZTIME(JL)-ZMAXTIME(JL))) ! WHERE(ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
@@ -1302,6 +1686,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
!When a specy is missing, only the external tendencies can be active and we do not want to recompute
!the microphysical tendencies when external tendencies are negative (results won't change because specy was already missing)
IF(XMRSTEP/=0.) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
&MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RV(JL)))) ! WHERE(ABS(ZA_RV(:))>1.E-20)
@@ -1383,6 +1768,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
ENDDO
IF(KRR==7) THEN
+!$acc loop independent
DO JL=1, IMICRO
ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
&MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RH(JL)))) ! WHERE(ABS(ZA_RH(:))>1.E-20)
@@ -1399,6 +1785,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
ENDDO
ENDIF
+!$acc loop independent
DO JL=1, IMICRO
ZW1D(JL)=MAX(ABS(ZB_RV(JL)), ABS(ZB_RC(JL)), ABS(ZB_RR(JL)), ABS(ZB_RI(JL)), &
&ABS(ZB_RS(JL)), ABS(ZB_RG(JL)), ABS(ZB_RH(JL)))
@@ -1546,6 +1933,7 @@ CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, GDNOTMICRO, &
PRVT, &
PCIT, ZZ_RVHENI_MR)
!$acc kernels
+!$acc loop independent collapse(3)
DO JK = 1, KKT
DO JJ = 1, KJT
DO JI = 1, KIT
@@ -1577,10 +1965,11 @@ end if
!
! ZW_??S variables will contain the new S variables values
!
-!$acc kernels
IF(GEXT_TEND) THEN
+!$acc kernels
!Z..T variables contain the exeternal tendency, we substract it
- DO JL=1, IMICRO
+!$acc loop independent
+ DO CONCURRENT ( JL = 1 : IMICRO )
ZRVT(JL) = ZRVT(JL) - ZEXT_RV(JL) * PTSTEP
ZRCT(JL) = ZRCT(JL) - ZEXT_RC(JL) * PTSTEP
ZRRT(JL) = ZRRT(JL) - ZEXT_RR(JL) * PTSTEP
@@ -1588,10 +1977,17 @@ IF(GEXT_TEND) THEN
ZRST(JL) = ZRST(JL) - ZEXT_RS(JL) * PTSTEP
ZRGT(JL) = ZRGT(JL) - ZEXT_RG(JL) * PTSTEP
ZTHT(JL) = ZTHT(JL) - ZEXT_TH(JL) * PTSTEP
- ENDDO
- IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
-ENDIF
+ END DO
+!$acc end kernels
+ IF (KRR==7) THEN
+!$acc kernels
+!$acc loop independent
+ DO CONCURRENT ( JL = 1 : IMICRO )
+ ZRHT(JL) = ZRHT(JL) - ZEXT_RH(JL) * PTSTEP
+ END DO
!$acc end kernels
+ END IF
+END IF
!$acc update self(ZRVT)
!Tendencies computed from difference between old state and new state (can be negative)
#ifndef MNH_OPENACC
@@ -2233,8 +2629,14 @@ IF(LSEDIM_AFTER) THEN
&PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
ENDIF
ENDIF
-!
-!
+
+!$acc end data
+
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"RAIN_ICE_RED end:PCIT")
@@ -2259,8 +2661,6 @@ END IF
!$acc end data
-!$acc end data
-
CONTAINS
!
SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &
@@ -2277,8 +2677,13 @@ CONTAINS
INTEGER :: JI, JJ, JK
!
!
+#ifndef MNH_OPENACC
LOGICAL, DIMENSION(:,:,:), allocatable :: GW
REAL, DIMENSION(:,:,:), allocatable :: ZW
+#else
+ LOGICAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: GW
+ REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZW
+#endif
!
!$acc data present( PRV, PRC, PRR, PRI, PRS, PRG, PTH, PLVFACT, PLSFACT, PRH )
!
@@ -2297,10 +2702,18 @@ CONTAINS
CALL MPPDB_CHECK(PTH,"CORRECT_NEGATIVITIES beg:PTH")
END IF
+#ifndef MNH_OPENACC
allocate( gw(size( prv, 1 ), size( prv, 2 ), size( prv, 3 ) ) )
allocate( zw(size( prv, 1 ), size( prv, 2 ), size( prv, 3 ) ) )
+#else
+ !Pin positions in the pools of MNH memory
+ CALL MNH_MEM_POSITION_PIN()
+
+ CALL MNH_MEM_GET( gw, size( prv, 1 ), size( prv, 2 ), size( prv, 3 ) )
+ CALL MNH_MEM_GET( zw, size( prv, 1 ), size( prv, 2 ), size( prv, 3 ) )
-!$acc data create(GW,ZW)
+!$acc data present( GW, ZW )
+#endif
!$acc kernels
!We correct negativities with conservation
@@ -2397,7 +2810,14 @@ CONTAINS
ENDDO
ENDIF
!$acc end kernels
- !
+
+!$acc end data
+
+#ifdef MNH_OPENACC
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE()
+#endif
+
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRV,"CORRECT_NEGATIVITIES end:PRV")
@@ -2409,13 +2829,10 @@ CONTAINS
IF(PRESENT(PRH)) CALL MPPDB_CHECK(PRH,"CORRECT_NEGATIVITIES end:PRH")
CALL MPPDB_CHECK(PTH,"CORRECT_NEGATIVITIES end:PTH")
END IF
- !
-!$acc end data
!$acc end data
- !
- END SUBROUTINE CORRECT_NEGATIVITIES
+ END SUBROUTINE CORRECT_NEGATIVITIES
!
END SUBROUTINE RAIN_ICE_RED
diff --git a/src/MNH/rain_ice_slow.f90 b/src/MNH/rain_ice_slow.f90
index 3f54aa8877adf7b4b9d4cca8750bdecaedc26119..64fc0840ebade6840d108fd92d91b01961131aa3 100644
--- a/src/MNH/rain_ice_slow.f90
+++ b/src/MNH/rain_ice_slow.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -35,6 +35,9 @@ use MODD_RAIN_ICE_PARAM, only: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA
XEX0DEPG, XEX0DEPS, XEX1DEPG, XEX1DEPS, XEXIAGGS, XFIAGGS, XHON, XSCFAC, XTEXAUTI, XTIMAUTI
use mode_budget, only: Budget_store_add
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_BITREP
@@ -75,10 +78,17 @@ REAL, DIMENSION(:), intent(OUT) :: PLBDAG ! Slope parameter of the g
!
!* 0.2 declaration of local variables
!
+#ifndef MNH_OPENACC
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
REAL, DIMENSION(:), ALLOCATABLE :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
real, dimension(:), ALLOCATABLE :: zz_diff
+#else
+LOGICAL, DIMENSION(:), pointer, contiguous :: GWORK
+REAL, DIMENSION(:), pointer, contiguous :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
+REAL, DIMENSION(:), pointer, contiguous :: ZZW ! Work array
+real, dimension(:), pointer, contiguous :: zz_diff
+#endif
!
INTEGER :: JL,JLU
!-------------------------------------------------------------------------------
@@ -122,11 +132,22 @@ END IF
!
JLU = size(PRHODREF)
!
-ALLOCATE( GWORK (size(PRHODREF)) )
-ALLOCATE( ZZW (size(PRHODREF)) )
-ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
+#ifndef MNH_OPENACC
+ALLOCATE( GWORK (JLU) )
+ALLOCATE( ZZW (JLU) )
+ALLOCATE( ZCRIAUTI(JLU) )
ALLOCATE( zz_diff (size(PLSFACT)) )
-!$acc data create( gwork, zzw, zcriauti, zz_diff )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_SLOW' )
+
+CALL MNH_MEM_GET( GWORK, JLU )
+CALL MNH_MEM_GET( ZZW, JLU )
+CALL MNH_MEM_GET( ZCRIAUTI, JLU )
+CALL MNH_MEM_GET( zz_diff, SIZE(PLSFACT) )
+
+!$acc data present( gwork, zzw, zcriauti, zz_diff )
+#endif
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
@@ -375,6 +396,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'RAIN_ICE_SLOW' )
+#endif
+
!$acc end data
END SUBROUTINE RAIN_ICE_SLOW
diff --git a/src/MNH/rain_ice_warm.f90 b/src/MNH/rain_ice_warm.f90
index a524b3949ca194b914ae299ad1a54d0f2f8063fb..ed6907b42e0cd8ef6a99c4af3881c2bb4411961b 100644
--- a/src/MNH/rain_ice_warm.f90
+++ b/src/MNH/rain_ice_warm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -35,6 +35,9 @@ use MODD_RAIN_ICE_DESCR, only: XCEXVT, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0EVAR, X1EVAR, XCRIAUTC, XEX0EVAR, XEX1EVAR, XEXCACCR, XFCACCR, XTIMAUTC
use mode_budget, only: Budget_store_add
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
use MODE_MSG
@@ -84,11 +87,19 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!* 0.2 declaration of local variables
!
INTEGER :: JL
+#ifndef MNH_OPENACC
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
REAL, DIMENSION(:), ALLOCATABLE :: ZZW2 ! Work array
REAL, DIMENSION(:), ALLOCATABLE :: ZZW3 ! Work array
REAL, DIMENSION(:), ALLOCATABLE :: ZZW4 ! Work array
+#else
+LOGICAL, DIMENSION(:), pointer, contiguous :: GWORK
+REAL, DIMENSION(:), pointer, contiguous :: ZZW ! Work array
+REAL, DIMENSION(:), pointer, contiguous :: ZZW2 ! Work array
+REAL, DIMENSION(:), pointer, contiguous :: ZZW3 ! Work array
+REAL, DIMENSION(:), pointer, contiguous :: ZZW4 ! Work array
+#endif
!
INTEGER :: JLU
!
@@ -146,13 +157,24 @@ END IF
!
JLU = size(PRHODREF)
!
-ALLOCATE( GWORK(size(PRHODREF)) )
-ALLOCATE( ZZW (size(PRHODREF)) )
-ALLOCATE( ZZW2 (size(PRHODREF)) )
-ALLOCATE( ZZW3 (size(PRHODREF)) )
-ALLOCATE( ZZW4 (size(PRHODREF)) )
+#ifndef MNH_OPENACC
+ALLOCATE( GWORK(JLU) )
+ALLOCATE( ZZW (JLU) )
+ALLOCATE( ZZW2 (JLU) )
+ALLOCATE( ZZW3 (JLU) )
+ALLOCATE( ZZW4 (JLU) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_WARM' )
-!$acc data create( gwork, zzw, zzw2, zzw3, zzw4 )
+CALL MNH_MEM_GET( GWORK, JLU )
+CALL MNH_MEM_GET( ZZW, JLU )
+CALL MNH_MEM_GET( ZZW2, JLU )
+CALL MNH_MEM_GET( ZZW3, JLU )
+CALL MNH_MEM_GET( ZZW4, JLU )
+
+!$acc data present( gwork, zzw, zzw2, zzw3, zzw4 )
+#endif
!
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
@@ -409,6 +431,11 @@ END IF
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'RAIN_ICE_WARM' )
+#endif
+
!$acc end data
END SUBROUTINE RAIN_ICE_WARM
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index d57fd7eb5548d469a02337e18a80ad2c44447171..f5b957aa8680156d7643e76833368413ee4c6c43 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -472,9 +472,15 @@ INTEGER :: IKL
INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: JI,JJ,JK,JL
!
+#ifndef MNH_OPENACC
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZZ
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZZ
+#else
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZDZZ
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZEXN
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZZZ
+#endif
! model layer height
! REAL :: ZMASSTOT ! total mass for one water category
! ! including the negative values
@@ -484,18 +490,32 @@ REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZZZ
!
INTEGER :: ISVBEG ! first scalar index for microphysics
INTEGER :: ISVEND ! last scalar index for microphysics
+#ifndef MNH_OPENACC
REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLMICRO ! mask to limit computation
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFPR
+#else
+REAL, DIMENSION(:), POINTER , CONTIGUOUS :: ZRSMIN ! Minimum value for tendencies
LOGICAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: LLMICRO ! mask to limit computation
REAL, DIMENSION(:,:,:,:), POINTER , CONTIGUOUS :: ZFPR
+#endif
!
INTEGER :: JMOD, JMOD_IFN
LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
! BVIE work array waiting for PINPRI
+#ifndef MNH_OPENACC
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINPRI
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZICEFR
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPRCFR
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHSSTEP
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRSSTEP
+#else
REAL, DIMENSION(:,:), POINTER , CONTIGUOUS :: ZINPRI
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZICEFR
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZPRCFR
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZTHSSTEP
REAL, DIMENSION(:,:,:,:), POINTER , CONTIGUOUS :: ZRSSTEP
+#endif
!
INTEGER :: JIU,JJU,JKU
!
@@ -625,10 +645,15 @@ CALL MNH_MEM_GET( ZZZ ,JIU,JJU,JKU )
CALL MNH_MEM_GET( ZINPRI ,JIU,JJU )
CALL MNH_MEM_GET( ZTHSSTEP , SIZE(PTHS,1), SIZE(PTHS,2), SIZE(PTHS,3) )
CALL MNH_MEM_GET( ZRSSTEP , SIZE(PRS,1), SIZE(PRS,2), SIZE(PRS,3), SIZE(PRS,4) )
-#endif
+IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN
+ CALL MNH_MEM_GET( ZRSMIN, SIZE( XRTMIN ) )
+ELSE
+ CALL MNH_MEM_GET( ZRSMIN, 0 )
+END IF
-!$acc data present( LLMICRO, ZDZZ, ZEXN, ZFPR, ZICEFR, ZPRCFR, ZZZ, ZINPRI, ZTHSSTEP, ZRSSTEP )
+!$acc data present( LLMICRO, ZDZZ, ZEXN, ZFPR, ZICEFR, ZPRCFR, ZZZ, ZINPRI, ZTHSSTEP, ZRSSTEP, ZRSMIN )
+#endif
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKA=1
@@ -658,8 +683,6 @@ ELSE
END IF
!
IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN
- ALLOCATE(ZRSMIN(SIZE(XRTMIN)))
-!$acc enter data create(ZRSMIN)
!$acc kernels
ZRSMIN(:) = XRTMIN(:) / PTSTEP
!$acc end kernels
@@ -942,17 +965,19 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
ENDIF
IF (LRED) THEN
!$acc kernels
- LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
- PRT(:,:,:,3)>XRTMIN(3) .OR. &
- PRT(:,:,:,4)>XRTMIN(4) .OR. &
- PRT(:,:,:,5)>XRTMIN(5) .OR. &
- PRT(:,:,:,6)>XRTMIN(6)
- LLMICRO(:,:,:)=LLMICRO(:,:,:) .OR. &
- PRS(:,:,:,2)>ZRSMIN(2) .OR. &
- PRS(:,:,:,3)>ZRSMIN(3) .OR. &
- PRS(:,:,:,4)>ZRSMIN(4) .OR. &
- PRS(:,:,:,5)>ZRSMIN(5) .OR. &
- PRS(:,:,:,6)>ZRSMIN(6)
+!$acc loop independent
+ DO CONCURRENT( JI = 1 : JIU, JJ = 1 : JJU, JK = 1 : JKU )
+ LLMICRO(JI,JJ,JK)=PRT(JI,JJ,JK,2)>XRTMIN(2) .OR. &
+ PRT(JI,JJ,JK,3)>XRTMIN(3) .OR. &
+ PRT(JI,JJ,JK,4)>XRTMIN(4) .OR. &
+ PRT(JI,JJ,JK,5)>XRTMIN(5) .OR. &
+ PRT(JI,JJ,JK,6)>XRTMIN(6) .OR. &
+ PRS(JI,JJ,JK,2)>ZRSMIN(2) .OR. &
+ PRS(JI,JJ,JK,3)>ZRSMIN(3) .OR. &
+ PRS(JI,JJ,JK,4)>ZRSMIN(4) .OR. &
+ PRS(JI,JJ,JK,5)>ZRSMIN(5) .OR. &
+ PRS(JI,JJ,JK,6)>ZRSMIN(6)
+ END DO
!$acc end kernels
CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), &
OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI, &
@@ -1280,11 +1305,10 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRAINFR,"RESOLVED_CLOUD end:PRAINFR")
END IF
-!$acc exit data delete(ZRSMIN)
-
!$acc end data
#ifndef MNH_OPENACC
+deallocate( ZRSMIN )
deallocate( ZRSSTEP )
deallocate( ZTHSSTEP )
deallocate( ZINPRI )
diff --git a/src/MNH/rotate_wind.f90 b/src/MNH/rotate_wind.f90
index 6146dc637d9caeebf9f880631edbfb4f120327d5..e7b2e6f2799eb1ec6577e2eccf8a0faa0cd82e0d 100644
--- a/src/MNH/rotate_wind.f90
+++ b/src/MNH/rotate_wind.f90
@@ -108,6 +108,9 @@ END MODULE MODI_ROTATE_WIND
! ------------
USE MODD_PARAMETERS
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_BITREP
@@ -138,11 +141,19 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PVSLOPE ! wind component along
!
! 0.2 declaration of local variables
!
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:,:), allocatable :: ILOC,JLOC ! shift index to find the 4 nearest points in x and y directions
REAL, DIMENSION(:,:), allocatable :: ZCOEFF,ZCOEFM, & ! interpolation weigths for flux and mass locations
ZUINT,ZVINT,ZWINT, & ! intermediate values of the cartesian components after x interp.
ZUFIN,ZVFIN,ZWFIN, & ! final values of the cartesian components after the 2 interp.
ZWGROUND ! vertical velocity at the surface
+#else
+INTEGER, DIMENSION(:,:), pointer, contiguous :: ILOC,JLOC ! shift index to find the 4 nearest points in x and y directions
+REAL, DIMENSION(:,:), pointer, contiguous :: ZCOEFF,ZCOEFM, & ! interpolation weigths for flux and mass locations
+ ZUINT,ZVINT,ZWINT, & ! intermediate values of the cartesian components after x interp.
+ ZUFIN,ZVFIN,ZWFIN, & ! final values of the cartesian components after the 2 interp.
+ ZWGROUND ! vertical velocity at the surface
+#endif
INTEGER :: IIB,IIE,IJB,IJE,IKB ! index values for the Beginning or the End of the physical domain in x,y and z directions
INTEGER :: IIU,IJU ! arrays' sizes for i and j indices
INTEGER :: JI,JJ
@@ -167,6 +178,7 @@ if ( mppdb_initialized ) then
call Mppdb_check( pdzz, "Rotate_wind beg:pdzz" )
end if
+#ifndef MNH_OPENACC
allocate( iloc (size( pdircosxw, 1 ), size( pdircosxw, 2 ) ) )
allocate( jloc (size( pdircosxw, 1 ), size( pdircosxw, 2 ) ) )
allocate( zcoeff (size( pdircosxw, 1 ), size( pdircosxw, 2 ) ) )
@@ -178,8 +190,25 @@ allocate( zufin (size( pdircosxw, 1 ), size( pdircosxw, 2 ) ) )
allocate( zvfin (size( pdircosxw, 1 ), size( pdircosxw, 2 ) ) )
allocate( zwfin (size( pdircosxw, 1 ), size( pdircosxw, 2 ) ) )
allocate( zwground(size( pdircosxw, 1 ), size( pdircosxw, 2 ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'ROTATE_WIND' )
+
+CALL MNH_MEM_GET( iloc, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( jloc, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zcoeff, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zcoefm, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zuint, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zvint, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zwint, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zufin, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zvfin, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zwfin, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+CALL MNH_MEM_GET( zwground, size( pdircosxw, 1 ), size( pdircosxw, 2 ) )
+
+!$acc data present( iloc, jloc, zcoeff, zcoefm, zuint, zvint, zwint, zufin, zvfin, zwfin, zwground )
+#endif
-!$acc data create( iloc, jloc, zcoeff, zcoefm, zuint, zvint, zwint, zufin, zvfin, zwfin, zwground )
!
!* 1. PRELIMINARIES
! -------------
@@ -206,6 +235,7 @@ JLOC(:,:)=NINT(SIGN(1.,-PSINSLOPE(:,:)))
!
! interpolation in x direction
!
+!$acc loop independent collapse(2)
DO JJ = 1,IJU
DO JI = IIB,IIE
ZCOEFF(JI,JJ) = &
@@ -227,6 +257,7 @@ END DO
!
! interpolation in y direction
!
+!$acc loop independent collapse(2)
DO JJ = IJB,IJE
DO JI = IIB,IIE
ZCOEFF(JI,JJ) = &
@@ -273,6 +304,11 @@ end if
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'ROTATE_WIND' )
+#endif
+
!$acc end data
!----------------------------------------------------------------------------
diff --git a/src/MNH/tm06_h.f90 b/src/MNH/tm06_h.f90
index a0522e45a6fd39313214352960fae55137bd994e..52c82e0672e152e5dedeb519f99b381da3ec3b93 100644
--- a/src/MNH/tm06_h.f90
+++ b/src/MNH/tm06_h.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2005-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -70,6 +70,9 @@ END MODULE MODI_TM06_H
!
USE MODD_PARAMETERS, ONLY : XUNDEF
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_OPENACC
use mode_msg
@@ -95,10 +98,17 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
!
!
INTEGER :: JK ! loop counter
+#ifndef MNH_OPENACC
LOGICAL, DIMENSION(:,:), allocatable :: GWORK
REAL :: ZGROWTH ! maximum BL growth rate
REAL, DIMENSION(:,:), allocatable :: ZFLXZMIN ! minimum of temperature flux
REAL, DIMENSION(:,:), allocatable :: ZBL_DEPTH ! BL depth at previous time-step
+#else
+LOGICAL, DIMENSION(:,:), pointer, contiguous :: GWORK
+REAL :: ZGROWTH ! maximum BL growth rate
+REAL, DIMENSION(:,:), pointer, contiguous :: ZFLXZMIN ! minimum of temperature flux
+REAL, DIMENSION(:,:), pointer, contiguous :: ZBL_DEPTH ! BL depth at previous time-step
+#endif
!----------------------------------------------------------------------------
!$acc data present( PZZ, PFLXZ, PBL_DEPTH )
@@ -115,11 +125,20 @@ if ( mppdb_initialized ) then
call Mppdb_check( pbl_depth, "Tm06_h beg:pbl_depth" )
end if
+#ifndef MNH_OPENACC
allocate( ZFLXZMIN (size( pzz, 1 ), size( pzz, 2 ) ) )
allocate( ZBL_DEPTH(size( pzz, 1 ), size( pzz, 2 ) ) )
allocate( GWORK (size( pzz, 1 ), size( pzz, 2 ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'TM06_H' )
+
+CALL MNH_MEM_GET( ZFLXZMIN, size( pzz, 1 ), size( pzz, 2 ) )
+CALL MNH_MEM_GET( ZBL_DEPTH, size( pzz, 1 ), size( pzz, 2 ) )
+CALL MNH_MEM_GET( GWORK, size( pzz, 1 ), size( pzz, 2 ) )
-!$acc data create( zflxzmin, zbl_depth, gwork )
+!$acc data present( zflxzmin, zbl_depth, gwork )
+#endif
!* mixed boundary layer cannot grow more rapidly than 1800m/h
!$acc kernels
@@ -156,6 +175,11 @@ end if
!$acc end data
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'TM06_H' )
+#endif
+
!$acc end data
!----------------------------------------------------------------------------
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index 82561c32d808cbaa3738380dcf6cee26d3741ebb..6b94ce84b5f76d676fdb89e749cb9ea13b7a24d7 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -771,21 +771,30 @@ IF (KRRL >=1) THEN
!
!* 2.5 Lv/Cph/Exn
!
- IF ( KRRI >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+#ifndef MNH_OPENACC
ALLOCATE(ZLVOCPEXNM(JIU,JJU,JKU))
ALLOCATE(ZLSOCPEXNM(JIU,JJU,JKU))
ALLOCATE(ZAMOIST_ICE(JIU,JJU,JKU))
ALLOCATE(ZATHETA_ICE(JIU,JJU,JKU))
+#else
+ CALL MNH_MEM_POSITION_PIN()
+ CALL MNH_MEM_GET( ZLVOCPEXNM, JIU, JJU, JKU )
+ CALL MNH_MEM_GET( ZLSOCPEXNM, JIU, JJU, JKU )
-!$acc enter data create( zlvocpexnm, zlsocpexnm )
-!$acc data create( zamoist_ice, zatheta_ice )
+ CALL MNH_MEM_POSITION_PIN()
+ CALL MNH_MEM_GET( ZAMOIST_ICE, JIU, JJU, JKU )
+ CALL MNH_MEM_GET( ZATHETA_ICE, JIU, JJU, JKU )
+#endif
+
+!$acc data present( zamoist_ice, zatheta_ice )
CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
ZLVOCPEXNM,ZAMOIST,ZATHETA)
CALL COMPUTE_FUNCTION_THERMO(XALPI,XBETAI,XGAMI,XLSTT,XCI,ZT,ZEXN,ZCP, &
ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE)
!
-!$acc kernels
+!$acc kernels present( zamoist, zatheta, zlocpexnm, zlvocpexnm, zlsocpexnm, zamoist_ice, zatheta_ice )
WHERE(PRT(:,:,:,2)+PRT(:,:,:,4)>0.0)
ZFRAC_ICE(:,:,:) = PRT(:,:,:,4) / ( PRT(:,:,:,2)+PRT(:,:,:,4) )
END WHERE
@@ -799,8 +808,12 @@ IF (KRRL >=1) THEN
!$acc end kernels
!$acc end data
+#ifndef MNH_OPENACC
DEALLOCATE(ZAMOIST_ICE)
DEALLOCATE(ZATHETA_ICE)
+#else
+ CALL MNH_MEM_RELEASE()
+#endif
ELSE
CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
ZLOCPEXNM,ZAMOIST,ZATHETA)
@@ -835,7 +848,7 @@ IF (KRRL >=1) THEN
END IF
!
ELSE
-!$acc kernels
+!$acc kernels present( zlocpexnm )
ZLOCPEXNM=0.
!$acc end kernels
END IF ! loop end on KRRL >= 1
@@ -844,7 +857,7 @@ END IF ! loop end on KRRL >= 1
!
!$acc update device(PRRS,PRTHLS)
IF ( KRRL >= 1 ) THEN
-!$acc kernels
+!$acc kernels present( zlocpexnm )
IF ( KRRI >= 1 ) THEN
! Rnp at t
PRT(:,:,:,1) = PRT(:,:,:,1) + PRT(:,:,:,2) + PRT(:,:,:,4)
@@ -974,7 +987,7 @@ ZLEPS(:,:,:)=PLEM(:,:,:)
!* 3.7 Correction in the Surface Boundary Layer (Redelsperger 2001)
! ----------------------------------------
!
-ZLMO=XUNDEF
+ZLMO(:,:)=XUNDEF
!$acc end kernels
IF (ORMC01) THEN
!$acc update self(PLEM,ZLEPS)
@@ -1146,7 +1159,7 @@ if ( lbudget_th ) then
!$acc end kernels
call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', ZTEMP_BUD(:,:,:) )
else if ( krrl >= 1 ) then
- !$acc kernels present(ZTEMP_BUD)
+ !$acc kernels present( ZTEMP_BUD, zlocpexnm )
ZTEMP_BUD(:,:,:) = prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2)
!$acc end kernels
call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', ZTEMP_BUD(:,:,:) )
@@ -1212,7 +1225,7 @@ if ( lbudget_th ) then
!$acc end kernels
call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', ZTEMP_BUD(:,:,:) )
else if ( krrl >= 1 ) then
- !$acc kernels present(ZTEMP_BUD)
+ !$acc kernels present(ZTEMP_BUD, zlocpexnm )
ZTEMP_BUD(:,:,:) = prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2)
!$acc end kernels
call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', ZTEMP_BUD(:,:,:) )
@@ -1259,7 +1272,7 @@ if ( hturbdim == '3DIM' ) then
!$acc end kernels
call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', ZTEMP_BUD(:,:,:) )
else if ( krrl >= 1 ) then
- !$acc kernels present(ZTEMP_BUD)
+ !$acc kernels present(ZTEMP_BUD, zlocpexnm )
ZTEMP_BUD(:,:,:) = prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2)
!$acc end kernels
call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', ZTEMP_BUD(:,:,:) )
@@ -1321,7 +1334,7 @@ if ( hturbdim == '3DIM' ) then
!$acc end kernels
call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', ZTEMP_BUD(:,:,:) )
else if ( krrl >= 1 ) then
- !$acc kernels present(ZTEMP_BUD)
+ !$acc kernels present(ZTEMP_BUD, zlocpexnm )
ZTEMP_BUD(:,:,:) = prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2)
!$acc end kernels
call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', ZTEMP_BUD(:,:,:) )
@@ -1461,11 +1474,14 @@ IF ( KRRL >= 1 ) THEN
!$acc end kernels
!$acc update self(PRT(:,:,:,1))
!
-!$acc exit data delete( zlvocpexnm, zlsocpexnm )
+#ifndef MNH_OPENACC
DEALLOCATE(ZLVOCPEXNM)
DEALLOCATE(ZLSOCPEXNM)
+#else
+ CALL MNH_MEM_RELEASE()
+#endif
ELSE
-!$acc kernels
+!$acc kernels present( zlocpexnm )
PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2)
PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2)
PTHLT(:,:,:) = PTHLT(:,:,:) + ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
@@ -1887,7 +1903,7 @@ CALL MNH_MEM_GET( zdrvsatdt, size( pexn, 1 ), size( pexn, 2 ), size( pexn, 3 ) )
!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
CALL MNH_MEM_RELEASE()
#endif
-
+
!$acc end data
END SUBROUTINE COMPUTE_FUNCTION_THERMO
@@ -2158,13 +2174,16 @@ if ( mppdb_initialized ) then
end if
#ifdef MNH_OPENACC
-allocate( ztmp1_device( size( pdxx, 1 ), size( pdxx, 2 ), size( pdxx, 3 ) ) )
-allocate( ztmp2_device( size( pdxx, 1 ), size( pdxx, 2 ), size( pdxx, 3 ) ) )
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ztmp1_device, size( pdxx, 1 ), size( pdxx, 2 ), size( pdxx, 3 ) )
+CALL MNH_MEM_GET( ztmp2_device, size( pdxx, 1 ), size( pdxx, 2 ), size( pdxx, 3 ) )
#endif
GOCEAN = LOCEAN
-!$acc data create( ztmp1_device, ztmp2_device )
+!$acc data present( ztmp1_device, ztmp2_device )
IF (ODZ) THEN
!$acc kernels
@@ -2287,6 +2306,11 @@ end if
!$acc end data
+#ifdef MNH_OPENACC
+ !Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+ CALL MNH_MEM_RELEASE()
+#endif
+
!$acc end data
END SUBROUTINE DELT
diff --git a/src/MNH/turb_hor_sv_corr.f90 b/src/MNH/turb_hor_sv_corr.f90
index c22ad83ed63ed74e6dc3cff4bb28cc586979bc0d..ec6902e32f24497122a6c30f24ff380ae7b64e4d 100644
--- a/src/MNH/turb_hor_sv_corr.f90
+++ b/src/MNH/turb_hor_sv_corr.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -92,6 +92,9 @@ USE MODD_NSV, ONLY : NSV,NSV_LGBEG,NSV_LGEND
USE MODD_LES
USE MODD_BLOWSNOW
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_OPENACC
use mode_msg
@@ -141,7 +144,11 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
!
!* 0.2 declaration of local variables
!
+#ifndef MNH_OPENACC
REAL, DIMENSION(:,:,:), allocatable :: ZFLX, ZA
+#else
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZFLX, ZA
+#endif
!
INTEGER :: JSV ! loop counter
!
@@ -179,8 +186,18 @@ if ( mppdb_initialized ) then
call Mppdb_check( PSVM, "Turb_hor_sv_corr beg:PSVM" )
end if
+#ifndef MNH_OPENACC
allocate( zflx(size( psvm, 1 ), size( psvm, 2 ), size( psvm, 3 ) ) )
allocate( za (size( psvm, 1 ), size( psvm, 2 ), size( psvm, 3 ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'TURB_HOR_SV_CORR' )
+
+CALL MNH_MEM_GET( zflx, size( psvm, 1 ), size( psvm, 2 ), size( psvm, 3 ) )
+CALL MNH_MEM_GET( za, size( psvm, 1 ), size( psvm, 2 ), size( psvm, 3 ) )
+
+!$acc data present( zflx, za )
+#endif
CALL SECOND_MNH(ZTIME1)
!
@@ -273,5 +290,12 @@ END DO ! end loop JSV
!
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-!
+
+!$acc end data
+
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'TURB_HOR_SV_CORR' )
+#endif
+
END SUBROUTINE TURB_HOR_SV_CORR
diff --git a/src/MNH/turb_ver_sv_corr.f90 b/src/MNH/turb_ver_sv_corr.f90
index 1b5f2ed4013ee68410f839dbf425e3e6dd7f2821..4c78074cfc0076001d78a2106cbcefcaffe6b7c3 100644
--- a/src/MNH/turb_ver_sv_corr.f90
+++ b/src/MNH/turb_ver_sv_corr.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -105,6 +105,9 @@ USE MODD_CONF
USE MODD_NSV, ONLY : NSV,NSV_LGBEG,NSV_LGEND
USE MODD_BLOWSNOW
!
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
#ifdef MNH_OPENACC
use mode_msg
@@ -161,7 +164,11 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
!* 0.2 declaration of local variables
!
!
+#ifndef MNH_OPENACC
REAL, DIMENSION(:,:,:), allocatable :: ZA, ZFLXZ
+#else
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZA, ZFLXZ
+#endif
!
REAL :: ZCSV !constant for the scalar flux
!
@@ -198,8 +205,18 @@ if ( mppdb_initialized ) then
call Mppdb_check( ppsi_sv, "Turb_ver_sv_corr beg:ppsi_sv" )
end if
+#ifndef MNH_OPENACC
allocate( za (size( psvm, 1 ), size( psvm, 2 ), size( psvm, 3 ) ) )
allocate( zflxz(size( psvm, 1 ), size( psvm, 2 ), size( psvm, 3 ) ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN( 'TURB_VER_SV_CORR' )
+
+CALL MNH_MEM_GET( za, size( psvm, 1 ), size( psvm, 2 ), size( psvm, 3 ) )
+CALL MNH_MEM_GET( zflxz, size( psvm, 1 ), size( psvm, 2 ), size( psvm, 3 ) )
+
+!$acc data present( za, zflxz )
+#endif
CALL SECOND_MNH(ZTIME1)
!
@@ -268,6 +285,14 @@ END DO ! end of scalar loop
!
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+
+!$acc end data
+
+#ifdef MNH_OPENACC
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE( 'TURB_VER_SV_CORR' )
+#endif
+
!----------------------------------------------------------------------------
!
END SUBROUTINE TURB_VER_SV_CORR