From 2c0a736a245752b2bc03869fe4de8be6eca60f73 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 10 Feb 2022 13:23:25 +0100
Subject: [PATCH] Philippe 10/02/2022: OpenACC: use MNH_MEM_GET family calls in
several subroutines
---
src/MNH/advection_uvw.f90 | 72 +++++++++++++++++++++--------
src/MNH/condensation.f90 | 61 +++++++++++++++++--------
src/MNH/gravity.f90 | 46 ++++++++++++++-----
src/MNH/gravity_impl.f90 | 49 +++++++++++++-------
src/MNH/ice_adjust.f90 | 85 ++++++++++++++++++++++++-----------
src/ZSOLVER/advection_uvw.f90 | 1 +
6 files changed, 222 insertions(+), 92 deletions(-)
diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90
index 2d08a7842..f9f9048a4 100644
--- a/src/MNH/advection_uvw.f90
+++ b/src/MNH/advection_uvw.f90
@@ -107,6 +107,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
#endif
use mode_mppdb
@@ -155,32 +156,32 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
!
INTEGER :: IKE ! indice K End in z direction
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRUT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRVT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWT
! cartesian
! components of
! momentum
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUCT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVCT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWCT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRUCT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRVCT
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWCT
! contravariant
! components
! of momentum
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU, ZV, ZW
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZU, ZV, ZW
! Guesses at the end of the sub time step
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS_OTHER
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVS_OTHER
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWS_OTHER
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRUS_OTHER
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRVS_OTHER
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWS_OTHER
! Contribution of the RK time step
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS_ADV
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVS_ADV
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWS_ADV
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMXM_RHODJ
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMYM_RHODJ
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMZM_RHODJ
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRUS_ADV
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRVS_ADV
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWS_ADV
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZMXM_RHODJ
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZMYM_RHODJ
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZMZM_RHODJ
!
! Momentum tendencies due to advection
INTEGER :: ISPLIT ! Number of splitting loops
@@ -226,6 +227,7 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRWS,"ADVECTION_UVW beg:PRWS")
END IF
+#ifndef MNH_OPENACC
ALLOCATE( ZRUT ( IIU,IJU,IKU ) )
ALLOCATE( ZRVT ( IIU,IJU,IKU ) )
ALLOCATE( ZRWT ( IIU,IJU,IKU ) )
@@ -244,10 +246,33 @@ ALLOCATE( ZRWS_ADV ( 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()
+
+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( ZU, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZV, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZW, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRUS_OTHER, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRVS_OTHER, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRWS_OTHER, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRUS_ADV, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRVS_ADV, IIU, IJU, IKU )
+CALL MNH_MEM_GET( ZRWS_ADV, 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 )
+#endif
-!$acc data create( zrut, zrvt, zrwt, zruct, zrvct, zrwct, zu, zv, zw, &
-!$acc & zrus_other, zrvs_other, zrws_other, zrus_adv, zrvs_adv, zrws_adv, &
-!$acc & zmxm_rhodj, zmym_rhodj, zmzm_rhodj )
+!$acc data present( zrut, zrvt, zrwt, zruct, zrvct, zrwct, zu, zv, zw, &
+!$acc & zrus_other, zrvs_other, zrws_other, zrus_adv, zrvs_adv, zrws_adv, &
+!$acc & zmxm_rhodj, zmym_rhodj, zmzm_rhodj )
IKE = SIZE(PWT,3) - JPVEXT
!
@@ -466,6 +491,15 @@ END IF
!$acc end data
+#ifndef MNH_OPENACC
+DEALLOCATE(zrut, zrvt, zrwt, zruct, zrvct, zrwct, zu, zv, zw, &
+ zrus_other, zrvs_other, zrws_other, zrus_adv, zrvs_adv, zrws_adv, &
+ zmxm_rhodj, zmym_rhodj, zmzm_rhodj )
+#else
+!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 ADVECTION_UVW
diff --git a/src/MNH/condensation.f90 b/src/MNH/condensation.f90
index 771779ed4..150598e52 100644
--- a/src/MNH/condensation.f90
+++ b/src/MNH/condensation.f90
@@ -136,6 +136,9 @@ USE MODD_CST
USE MODD_PARAMETERS
USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
!
+#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
!
@@ -196,15 +199,15 @@ REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" va
!* 0.2 Declarations of local variables :
!
INTEGER :: JI, JJ, JK, JKP, JKM, IKTB, IKTE ! loop index
-REAL, DIMENSION(:,:,:), allocatable :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
-REAL, DIMENSION(:,:,:), allocatable :: ZL ! length scale
-REAL, DIMENSION(:,:,:), allocatable :: ZFRAC ! Ice fraction
-REAL :: ZCRIAUTI !
-INTEGER, DIMENSION(:,:), allocatable :: ITPL ! top levels of troposphere
-REAL, DIMENSION(:,:), allocatable :: ZTMIN ! minimum Temp. related to ITPL
-!
-REAL, DIMENSION(:,:,:), allocatable :: ZLV, ZLS, ZCPD
-REAL :: ZCOND
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZL ! length scale
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZFRAC ! Ice fraction
+REAL :: ZCRIAUTI !
+INTEGER, DIMENSION(:,:), POINTER, CONTIGUOUS :: ITPL ! top levels of troposphere
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZTMIN ! minimum Temp. related to ITPL
+!
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZLV, ZLS, ZCPD
+REAL :: ZCOND
REAL :: ZGCOND, ZSBAR, ZSBARC, ZQ1, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI ! Used for integration in Gaussian Probability Density Function
REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZLVS ! thermodynamics
REAL :: ZLL, DZZ, ZZZ ! used for length scales
@@ -213,7 +216,7 @@ REAL :: ZRCOLD, ZRIOLD
INTEGER :: INQ1
REAL :: ZINC
LOGICAL :: GPRESENT_PLV, GPRESENT_PLS, GPRESENT_PCPH
-LOGICAL, DIMENSION(:,:,:), allocatable :: GWORK
+LOGICAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: GWORK
CHARACTER(LEN=4) :: YLAMBDA3 !Necessary to workaround NVHPC bug (version 21.7 if OpenACC enabled)
!
!* 0.3 Definition of constants :
@@ -238,8 +241,6 @@ REAL, DIMENSION(-22:11),PARAMETER :: ZSRC_1D =(/ &
!
!-------------------------------------------------------------------------------
!
-!$acc data present(PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC)
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK3D(PPABS,"CONDENSATION beg:PPABS",PRECISION)
@@ -263,6 +264,7 @@ YLAMBDA3 = HLAMBDA3
IF( YLAMBDA3 /='CB' .AND. YLAMBDA3 /='NONE' ) &
call Print_msg( NVERB_FATAL, 'GEN', 'CONDENSATION', 'invalid value for YLAMBDA3: ' // TRIM( YLAMBDA3 ) )
+#ifndef MNH_OPENACC
allocate( ztlk (kiu, kju, kku ) )
allocate( zrt (kiu, kju, kku ) )
allocate( zl (kiu, kju, kku ) )
@@ -275,8 +277,26 @@ allocate( zlv (kiu, kju, kku ) )
allocate( zls (kiu, kju, kku ) )
allocate( zcpd (kiu, kju, kku ) )
allocate( gwork(kiu, kju, kku ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( ztlk, kiu, kju, kku )
+CALL MNH_MEM_GET( zrt, kiu, kju, kku )
+CALL MNH_MEM_GET( zl, kiu, kju, kku )
+CALL MNH_MEM_GET( zfrac, kiu, kju, kku )
-!$acc data create( ztlk, zrt, zl, zfrac, itpl, ztmin, zlv, zls,zcpd, gwork )
+CALL MNH_MEM_GET( itpl, kiu, kju )
+CALL MNH_MEM_GET( ztmin, kiu, kju )
+
+CALL MNH_MEM_GET( zlv, kiu, kju, kku )
+CALL MNH_MEM_GET( zls, kiu, kju, kku )
+CALL MNH_MEM_GET( zcpd, kiu, kju, kku )
+CALL MNH_MEM_GET( gwork, kiu, kju, kku )
+
+!$acc data present( PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, &
+!$acc & ztlk, zrt, zl, zfrac, itpl, ztmin, zlv, zls,zcpd, gwork )
+#endif
IKTB=1+JPVEXT
IKTE=KKU-JPVEXT
@@ -612,7 +632,16 @@ DO JK=IKTB,IKTE
!acc end kernels
END DO
!$acc end kernels
-!
+
+!$acc end data
+
+#ifndef MNH_OPENACC
+deallocate( ztlk, zrt, zl, zfrac, itpl, ztmin, zlv, zls,zcpd, gwork )
+#else
+!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_CHECK3D(PT,"CONDENSATION end:PT",PRECISION)
@@ -624,8 +653,4 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK3D(PSIGRC,"CONDENSATION end:PSIGRC",PRECISION)
END IF
-!$acc end data
-
-!$acc end data
-
END SUBROUTINE CONDENSATION
diff --git a/src/MNH/gravity.f90 b/src/MNH/gravity.f90
index da511c0da..66e3bdb79 100644
--- a/src/MNH/gravity.f90
+++ b/src/MNH/gravity.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.
@@ -109,6 +109,9 @@ USE MODD_CONF
USE MODD_CST
USE MODD_DYN_n, ONLY : LOCEAN
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
use mode_mppdb
USE MODI_GET_HALO
@@ -137,15 +140,15 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRWS ! Sources of Momentum
!
!* 0.2 Declarations of local variables :
!
+CHARACTER(LEN=3) :: YNUM
+INTEGER :: IIU, IJU, IKU ! dimensions of dummy arrays
REAL :: ZRV_OV_RD ! = RV / RD
INTEGER :: JWATER ! loop index on the different types of water
-REAL, DIMENSION(:,:,:), allocatable :: ZWORK1, ZWORK2
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZWORK1, ZWORK2
!
!
!-------------------------------------------------------------------------------
-!$acc data present(PTHT, PRT, PRHODJ, PTHVREF, PRWS)
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PRHODJ, "GRAVITY beg:PRHODJ")
@@ -155,10 +158,24 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRT, "GRAVITY beg:PRT")
END IF
-allocate( zwork1(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zwork2(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+IIU = SIZE( ptht, 1 )
+IJU = SIZE( ptht, 2 )
+IKU = SIZE( ptht, 3 )
+
+#ifndef MNH_OPENACC
+allocate( zwork1(IIU, IJU, IKU ) )
+allocate( zwork2(IIU, IJU, IKU ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( zwork1, IIU, IJU, IKU )
+CALL MNH_MEM_GET( zwork2, IIU, IJU, IKU )
+#endif
+
-!$acc data create( zwork1, zwork2 )
+!$acc data present( PTHT, PRT, PRHODJ, PTHVREF, PRWS, &
+!$acc & zwork1, zwork2 )
!
!* 1. COMPUTES THE GRAVITY TERM
! -------------------------
@@ -242,7 +259,16 @@ ELSE
!
END IF
END IF
-!
+
+!$acc end data
+
+#ifndef MNH_OPENACC
+deallocate( zwork1, zwork2 )
+#else
+!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(PTHT, "GRAVITY end:PTHT")
@@ -251,10 +277,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRWS, "GRAVITY end:PRWS")
END IF
-!$acc end data
-
-!$acc end data
-
!-------------------------------------------------------------------------------
!
END SUBROUTINE GRAVITY
diff --git a/src/MNH/gravity_impl.f90 b/src/MNH/gravity_impl.f90
index 3b6366dda..a5f7acadc 100644
--- a/src/MNH/gravity_impl.f90
+++ b/src/MNH/gravity_impl.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2011-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-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_budget, only: lbudget_w, NBUDGET_W, tbudgets
use mode_budget, only: Budget_store_init, Budget_store_end
use mode_mppdb
+#ifdef MNH_OPENACC
+use mode_mnh_zwork, only: Mnh_mem_get, Mnh_mem_position_pin, Mnh_mem_release
+#endif
use modi_adv_boundaries
use modi_gravity
@@ -119,21 +122,19 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD
!
!
! Tendencies of W due to gravity
-REAL, DIMENSION(:,:,:), allocatable :: ZRWS_GRAV
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWS_GRAV
! Guess of future theta
-REAL, DIMENSION(:,:,:), allocatable :: ZTH
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZTH
! Guess of future mixing ratios
-REAL, DIMENSION(:,:,:,:), allocatable :: ZR
+REAL, DIMENSION(:,:,:,:), POINTER, CONTIGUOUS :: ZR
!
INTEGER :: JR
!
INTEGER :: JI,JJ,JK
-INTEGER :: JIU,JJU,JKU
+INTEGER :: JIU, JJU, JKU, JRU
!
!-------------------------------------------------------------------------------
-!$acc data present( PTHT, PRHODJ, PRT, PTHVREF, PRWS, PRTHS, PRRS, PRTHS_CLD, PRRS_CLD )
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PTHT, "GRAVITY_IMPL beg:PTHT")
@@ -151,12 +152,23 @@ END IF
JIU = size(ptht, 1 )
JJU = size(ptht, 2 )
JKU = size(ptht, 3 )
+JRU = size( prt, 4 )
-allocate( zrws_grav( size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zth ( size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zr ( size( prt, 1 ), size( prt, 2 ), size( prt, 3 ), size( prt, 4 ) ) )
+#ifndef MNH_OPENACC
+allocate( zrws_grav(JIU, JJU, JKU ) )
+allocate( zth (JIU, JJU, JKU ) )
+allocate( zr (JIU, JJU, JKU, JRU ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
-!$acc data create( zrws_grav, zth, zr )
+CALL MNH_MEM_GET( zrws_grav, JIU, JJU, JKU )
+CALL MNH_MEM_GET( zth, JIU, JJU, JKU )
+CALL MNH_MEM_GET( zr, JIU, JJU, JKU, JRU )
+#endif
+
+!$acc data present( PTHT, PRHODJ, PRT, PTHVREF, PRWS, PRTHS, PRRS, PRTHS_CLD, PRRS_CLD, &
+!$acc & zrws_grav, zth, zr )
if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'GRAV', prws(:, :, :) )
@@ -195,16 +207,21 @@ if ( lbudget_w ) then
!$acc update self(PRWS)
call Budget_store_end( tbudgets(NBUDGET_W), 'GRAV', prws(:, :, :) )
end if
-!
+
+!$acc end data
+
+#ifndef MNH_OPENACC
+DEALLOCATE( zrws_grav, zth, zr )
+#else
+!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(PRWS,"GRAVITY_IMPL end:PRWS")
END IF
-!$acc end data
-
-!$acc end data
-
!-------------------------------------------------------------------------------
!
END SUBROUTINE GRAVITY_IMPL
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index 931a76fdb..58580edaa 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -190,6 +190,9 @@ USE MODD_PARAMETERS
USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
use mode_budget, only: Budget_store_init, Budget_store_end
+#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
@@ -277,10 +280,10 @@ INTEGER :: IKE ! K index value of the last inner mass point
INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
INTEGER :: JI,JJ,JK
!
-LOGICAL,DIMENSION(:,:,:), allocatable :: GTEMP
+LOGICAL,DIMENSION(:,:,:), POINTER, CONTIGUOUS :: GTEMP
!
-REAL, DIMENSION(:,:,:), allocatable :: ZSIGS,ZSRCS
-REAL, DIMENSION(:,:,:), allocatable &
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZSIGS,ZSRCS
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS &
:: ZT, & ! adjusted temperature
ZRV, ZRC, ZRI, & ! adjusted state
ZCPH, & ! guess of the CPh for the mixing
@@ -336,35 +339,56 @@ CALL MPPDB_CHECK3D(PRCS,"ICE_ADJUST beg:PRCS",PRECISION)
CALL MPPDB_CHECK3D(PTHS,"ICE_ADJUST beg:PTHS",PRECISION)
CALL MPPDB_CHECK3D(PRIS,"ICE_ADJUST beg:PRIS",PRECISION)
-allocate( gtemp (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zsigs (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zsrcs (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zt (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zrv (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zrc (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zri (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zcph (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zlv (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zls (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zw1 (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zw2 (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zcriaut(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zhcf (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zhr (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-
-!$acc data create( gtemp, zsigs, zsrcs, zt, zrv, zrc, zri, zcph, zlv, zls, zw1, zw2, zcriaut, zhcf, zhr )
-
-if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
-
IIU = SIZE(PEXNREF,1)
IJU = SIZE(PEXNREF,2)
IKU = SIZE(PEXNREF,3)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB=KKA+JPVEXT*KKL
IKE=KKU-JPVEXT*KKL
+
+#ifndef MNH_OPENACC
+allocate( gtemp (IIU, IJU, IKU ) )
+allocate( zsigs (IIU, IJU, IKU ) )
+allocate( zsrcs (IIU, IJU, IKU ) )
+allocate( zt (IIU, IJU, IKU ) )
+allocate( zrv (IIU, IJU, IKU ) )
+allocate( zrc (IIU, IJU, IKU ) )
+allocate( zri (IIU, IJU, IKU ) )
+allocate( zcph (IIU, IJU, IKU ) )
+allocate( zlv (IIU, IJU, IKU ) )
+allocate( zls (IIU, IJU, IKU ) )
+allocate( zw1 (IIU, IJU, IKU ) )
+allocate( zw2 (IIU, IJU, IKU ) )
+allocate( zcriaut(IIU, IJU, IKU ) )
+allocate( zhcf (IIU, IJU, IKU ) )
+allocate( zhr (IIU, IJU, IKU ) )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+
+CALL MNH_MEM_GET( gtemp , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zsigs , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zsrcs , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zt , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zrv , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zrc , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zri , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zcph , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zlv , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zls , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zw1 , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zw2 , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zcriaut, IIU, IJU, IKU )
+CALL MNH_MEM_GET( zhcf , IIU, IJU, IKU )
+CALL MNH_MEM_GET( zhr , IIU, IJU, IKU )
+
+!$acc data present( gtemp, zsigs, zsrcs, zt, zrv, zrc, zri, zcph, zlv, zls, zw1, zw2, zcriaut, zhcf, zhr )
+#endif
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
!
ITERMAX=1
!
@@ -620,6 +644,14 @@ if ( lbudget_ri ) then
call Budget_store_end( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
end if
+!$acc end data
+
+#ifndef MNH_OPENACC
+deallocate( gtemp, zsigs, zsrcs, zt, zrv, zrc, zri, zcph, zlv, zls, zw1, zw2, zcriaut, zhcf, zhr )
+#else
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
!------------------------------------------------------------------------------
!
!Check all INOUT arrays
@@ -638,7 +670,6 @@ IF (PRESENT(PHLC_HRC)) CALL MPPDB_CHECK3D(PHLC_HRC,"ICE_ADJUST end:PHLC_HRC")
IF (PRESENT(PHLC_HCF)) CALL MPPDB_CHECK3D(PHLC_HCF,"ICE_ADJUST end:PHLC_HCF")
IF (PRESENT(PHLI_HRI)) CALL MPPDB_CHECK3D(PHLI_HRI,"ICE_ADJUST end:PHLI_HRI")
IF (PRESENT(PHLI_HCF)) CALL MPPDB_CHECK3D(PHLI_HCF,"ICE_ADJUST end:PHLI_HCF")
-!$acc end data
!$acc end data
diff --git a/src/ZSOLVER/advection_uvw.f90 b/src/ZSOLVER/advection_uvw.f90
index b731655b2..9660d8993 100644
--- a/src/ZSOLVER/advection_uvw.f90
+++ b/src/ZSOLVER/advection_uvw.f90
@@ -108,6 +108,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
#endif
use mode_mppdb
--
GitLab