From f2ab98e8b46b809af8e38f13c16039cfb59d23ca Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Wed, 30 Mar 2022 10:41:24 +0200
Subject: [PATCH] Philippe 30/03/2022: OpenACC: use MNH_MEM_GET family calls in
more ZSOLVER/ subroutines
---
src/ZSOLVER/advection_uvw_cen.f90 | 100 +++++--
src/ZSOLVER/modeln.f90 | 7 +
src/ZSOLVER/rain_ice_red.f90 | 475 +++++++++++++++++++++++++++---
3 files changed, 526 insertions(+), 56 deletions(-)
diff --git a/src/ZSOLVER/advection_uvw_cen.f90 b/src/ZSOLVER/advection_uvw_cen.f90
index 7a8df745e..289737f14 100644
--- a/src/ZSOLVER/advection_uvw_cen.f90
+++ b/src/ZSOLVER/advection_uvw_cen.f90
@@ -105,6 +105,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
@@ -146,6 +147,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
@@ -175,6 +178,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
@@ -209,24 +243,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')
@@ -323,7 +382,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
@@ -354,6 +413,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/ZSOLVER/modeln.f90 b/src/ZSOLVER/modeln.f90
index 4415ac257..194b37a60 100644
--- a/src/ZSOLVER/modeln.f90
+++ b/src/ZSOLVER/modeln.f90
@@ -545,10 +545,17 @@ LOGICAL :: KACTIT
LOGICAL :: KSEDI
LOGICAL :: KHHONI
!
+#ifndef MNH_OPENACC
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRUS,ZRVS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRWS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPABST !To give pressure at t
+ ! (and not t+1) to resolved_cloud
+#else
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRUS,ZRVS
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZRWS
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPABST !To give pressure at t
! (and not t+1) to resolved_cloud
+#endif
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ
!
TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
diff --git a/src/ZSOLVER/rain_ice_red.f90 b/src/ZSOLVER/rain_ice_red.f90
index c57d38331..c362b0ee7 100644
--- a/src/ZSOLVER/rain_ice_red.f90
+++ b/src/ZSOLVER/rain_ice_red.f90
@@ -277,12 +277,14 @@ 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
#ifdef MNH_OPENACC
use mode_tools, only: Countjv_device
-USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
USE MODI_ICE4_NUCLEATION_WRAPPER
@@ -368,6 +370,8 @@ INTEGER :: IKE, IKTE !
!
INTEGER :: IDX, JI, JJ, JK
INTEGER :: IMICRO ! Case r_x>0 locations
+INTEGER :: JIU,JJU,JKU
+#ifndef MNH_OPENACC
INTEGER, DIMENSION(:), allocatable :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
@@ -519,25 +523,167 @@ 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
+ &ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS
!
-REAL, DIMENSION(:,:,:), pointer , contiguous :: ZTEMP_BUD
+REAL, DIMENSION(:,:,:), allocatable :: ZTEMP_BUD
+#else
+INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
!
-INTEGER :: JIU,JJU,JKU
+!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
!
-LOGICAL :: GTEST ! temporary variable for OpenACC character limitation (Cray CCE)
-
-JIU = size(ptht, 1 )
-JJU = size(ptht, 2 )
-JKU = size(ptht, 3 )
+!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
-#ifndef MNH_OPENACC
-ALLOCATE(ZTEMP_BUD(JIU,JJU,JKU))
-#else
-!Pin positions in the pools of MNH memory
-CALL MNH_MEM_POSITION_PIN()
-CALL MNH_MEM_GET(ZTEMP_BUD, JIU,JJU,JKU )
+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
+!
+REAL, DIMENSION(:,:,:), pointer, contiguous :: ZTEMP_BUD
#endif
+!
+LOGICAL :: GTEST ! temporary variable for OpenACC character limitation (Cray CCE)
!$acc data present( ODMICRO, PEXN, PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
!$acc & PHLC_HRC, PTHT, PRVT, &
@@ -588,8 +734,11 @@ END IF
imicro = count(odmicro)
!$acc end kernels
+JIU = size(ptht, 1 )
+JJU = size(ptht, 2 )
+JKU = size(ptht, 3 )
-
+#ifndef MNH_OPENACC
allocate( i1(imicro ) )
allocate( i2(imicro ) )
allocate( i3(imicro ) )
@@ -794,7 +943,218 @@ 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, &
+allocate( ZTEMP_BUD(JIU,JJU,JKU) )
+#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 ) )
+
+CALL MNH_MEM_GET( ZTEMP_BUD, JIU, JJU, JKU )
+
+!$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, &
@@ -816,8 +1176,10 @@ allocate( zw_ths(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
!$acc & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
!$acc & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
!$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 )
+!$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, &
+!$acc & ZTEMP_BUD )
+#endif
!-------------------------------------------------------------------------------
if ( lbu_enable ) then
@@ -873,6 +1235,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
@@ -887,6 +1250,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
@@ -1093,6 +1457,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))
@@ -1124,6 +1489,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
@@ -1137,6 +1503,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
@@ -1144,10 +1511,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
@@ -1249,12 +1618,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)) &
@@ -1265,6 +1638,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)) &
@@ -1306,6 +1680,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)
@@ -1325,6 +1700,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))
@@ -1342,6 +1718,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))
@@ -1375,6 +1752,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))
@@ -1387,6 +1765,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)
@@ -1399,6 +1778,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)
@@ -1480,6 +1860,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)
@@ -1496,6 +1877,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)))
@@ -1508,6 +1890,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
!
!*** 4.3 New values of variables for next iteration
!
+!$acc loop independent
DO JL=1, IMICRO
ZTHT(JL)=ZTHT(JL)+ZA_TH(JL)*ZMAXTIME(JL)+ZB_TH(JL)
ZRVT(JL)=ZRVT(JL)+ZA_RV(JL)*ZMAXTIME(JL)+ZB_RV(JL)
@@ -1643,6 +2026,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
@@ -1692,7 +2076,8 @@ end if
!$acc kernels
IF(GEXT_TEND) THEN
!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
@@ -2345,8 +2730,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")
@@ -2371,15 +2762,6 @@ END IF
!$acc end data
-!$acc end data
-
-#ifndef MNH_OPENACC
-DEALLOCATE(ZTEMP_BUD)
-#else
-!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
-CALL MNH_MEM_RELEASE()
-#endif
-
CONTAINS
!
SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &
@@ -2396,8 +2778,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 )
!
@@ -2416,10 +2803,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()
-!$acc data create(GW,ZW)
+ 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 present( GW, ZW )
+#endif
!$acc kernels
!We correct negativities with conservation
@@ -2516,7 +2911,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")
@@ -2528,13 +2930,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
--
GitLab