From 9f71dc0f818dcdf5598222be14338dc6255db228 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 24 May 2022 16:06:34 +0200
Subject: [PATCH] Philippe 24/05/2022: OpenACC Cray: add present_cr + move
 present for optional argument

---
 src/MNH/rain_ice_red.f90 | 129 ++++++++++++++++++++++-----------------
 1 file changed, 74 insertions(+), 55 deletions(-)

diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index ed80a9ede..6ce8681cf 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -370,6 +370,7 @@ 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
@@ -729,6 +730,10 @@ 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 ) )
@@ -737,22 +742,22 @@ allocate( i3(imicro ) )
 allocate( zw(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
 allocate( zt(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
 
-allocate( zz_rvheni_mr(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zz_rvheni   (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zz_lvfact   (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zz_lsfact   (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zlsfact3d   (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( zz_rvheni_mr(jiu, jju, jku ) )
+allocate( zz_rvheni   (jiu, jju, jku ) )
+allocate( zz_lvfact   (jiu, jju, jku ) )
+allocate( zz_lsfact   (jiu, jju, jku ) )
+allocate( zlsfact3d   (jiu, jju, jku ) )
 
-allocate( ZHLC_HCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( ZHLC_LCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( ZHLC_HRC3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( ZHLC_LRC3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( ZHLI_HCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( ZHLI_LCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( ZHLI_HRI3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( ZHLI_LRI3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLC_HCF3D(jiu, jju, jku ) )
+allocate( ZHLC_LCF3D(jiu, jju, jku ) )
+allocate( ZHLC_HRC3D(jiu, jju, jku ) )
+allocate( ZHLC_LRC3D(jiu, jju, jku ) )
+allocate( ZHLI_HCF3D(jiu, jju, jku ) )
+allocate( ZHLI_LCF3D(jiu, jju, jku ) )
+allocate( ZHLI_HRI3D(jiu, jju, jku ) )
+allocate( ZHLI_LRI3D(jiu, jju, jku ) )
 
-allocate( zinpri(size( ptht, 1 ), size( ptht, 2 ) ) )
+allocate( zinpri(jiu, jju ) )
 
 allocate( zrvt     (imicro ) )
 allocate( zrct     (imicro ) )
@@ -925,14 +930,14 @@ allocate( zrh_tend(imicro, 10 ) )
 
 allocate( zssi(imicro ) )
 
-allocate( zw_rvs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zw_rcs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zw_rrs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-allocate( zw_ris(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
-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 ) ) )
+allocate( zw_rvs(jiu, jju, jku ) )
+allocate( zw_rcs(jiu, jju, jku ) )
+allocate( zw_rrs(jiu, jju, jku ) )
+allocate( zw_ris(jiu, jju, jku ) )
+allocate( zw_rss(jiu, jju, jku ) )
+allocate( zw_rgs(jiu, jju, jku ) )
+allocate( zw_rhs(jiu, jju, jku ) )
+allocate( zw_ths(jiu, jju, jku ) )
 #else
 !Pin positions in the pools of MNH memory
 CALL MNH_MEM_POSITION_PIN()
@@ -944,22 +949,22 @@ 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( zz_rvheni_mr, jiu, jju, jku )
+CALL MNH_MEM_GET( zz_rvheni,    jiu, jju, jku )
+CALL MNH_MEM_GET( zz_lvfact,    jiu, jju, jku )
+CALL MNH_MEM_GET( zz_lsfact,    jiu, jju, jku )
+CALL MNH_MEM_GET( zlsfact3d,    jiu, jju, jku )
 
-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( ZHLC_HCF3D, jiu, jju, jku )
+CALL MNH_MEM_GET( ZHLC_LCF3D, jiu, jju, jku )
+CALL MNH_MEM_GET( ZHLC_HRC3D, jiu, jju, jku )
+CALL MNH_MEM_GET( ZHLC_LRC3D, jiu, jju, jku )
+CALL MNH_MEM_GET( ZHLI_HCF3D, jiu, jju, jku )
+CALL MNH_MEM_GET( ZHLI_LCF3D, jiu, jju, jku )
+CALL MNH_MEM_GET( ZHLI_HRI3D, jiu, jju, jku )
+CALL MNH_MEM_GET( ZHLI_LRI3D, jiu, jju, jku )
 
-CALL MNH_MEM_GET( zinpri, size( ptht, 1 ), size( ptht, 2 ) )
+CALL MNH_MEM_GET( zinpri, jiu, jju )
 
 CALL MNH_MEM_GET( zrvt     , imicro )
 CALL MNH_MEM_GET( zrct     , imicro )
@@ -1132,14 +1137,14 @@ 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( zw_rvs, jiu, jju, jku )
+CALL MNH_MEM_GET( zw_rcs, jiu, jju, jku )
+CALL MNH_MEM_GET( zw_rrs, jiu, jju, jku )
+CALL MNH_MEM_GET( zw_ris, jiu, jju, jku )
+CALL MNH_MEM_GET( zw_rss, jiu, jju, jku )
+CALL MNH_MEM_GET( zw_rgs, jiu, jju, jku )
+CALL MNH_MEM_GET( zw_rhs, jiu, jju, jku )
+CALL MNH_MEM_GET( zw_ths, jiu, jju, jku )
 
 !$acc data present( I1, I2, I3,                                                                                                &
 !$acc &            ZW, ZT, ZZ_RVHENI_MR, ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D, ZINPRI,                                   &
@@ -1163,8 +1168,8 @@ CALL MNH_MEM_GET( 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          )
 #endif
 
 !-------------------------------------------------------------------------------
@@ -1178,7 +1183,8 @@ end if
 !               -----------------------
 !
 CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!$acc kernels
+!$acc kernels present_cr( ZRS_TEND, ZRG_TEND, ZRH_TEND, ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, ZRCAUTR, ZRCACCR, ZRREVAV, &
+!$acc &                   ZRSMLTG, ZRCMLTSR, ZRICFRRG, ZRRCFRIG, ZRICFRR, ZRGMLTR, ZRHMLTR, ZRCBERI )
 IKB=KKA+JPVEXT*KKL
 IKE=KKU-JPVEXT*KKL
 IKTB=1+JPVEXT
@@ -1363,7 +1369,14 @@ CALL COUNTJV_DEVICE(ODMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
 !Packing
 GTEST=.false.
 IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') GTEST=.true.
-!$acc kernels
+!$acc kernels present_cr( ZSIGMA_RC, ZRHT, ZEXT_RH,                                                                                   &
+!$acc &                   ZTOT_RVHENI, ZTOT_RCHONI, ZTOT_RRHONG, ZTOT_RVDEPS, ZTOT_RIAGGS, ZTOT_RIAUTS, ZTOT_RVDEPG, ZTOT_RCAUTR,     &
+!$acc &                   ZTOT_RCACCR, ZTOT_RREVAV, ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, ZTOT_RIMLTC, ZTOT_RCBERI, ZTOT_RHMLTR,  &
+!$acc &                   ZTOT_RSMLTG, ZTOT_RCMLTSR, ZTOT_RRACCSS,  ZTOT_RRACCSG,  ZTOT_RSACCRG, ZTOT_RICFRRG,  ZTOT_RRCFRIG,         &
+!$acc &                   ZTOT_RICFRR, ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG,     &
+!$acc &                   ZTOT_RSDRYG, ZTOT_RWETGH, ZTOT_RGMLTR, ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH,     &
+!$acc &                   ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, ZTOT_RDRYHG                                )
+
 IF(IMICRO>0) THEN
 !$acc loop independent
   DO JL=1, IMICRO
@@ -1497,7 +1510,7 @@ IF(XTSTEP_TS/=0.)THEN
   INB_ITER_MAX=MAX(NMAXITER, INB_ITER_MAX) !For the case XMRSTEP/=0. at the same time
 ENDIF
 !acc end kernels
-!$acc kernels
+!$acc kernels present_cr( IITER, ZTIME )
 IITER(:)=0
 ZTIME(:)=0. ! Current integration time (all points may have a different integration time)
 !$acc end kernels
@@ -1798,6 +1811,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)
@@ -1876,7 +1890,7 @@ ENDDO
 !
 ! !$acc kernels
 IF(IMICRO>0) THEN
-!$acc kernels
+!$acc kernels present_cr( ZHLC_HCF3D, ZHLC_LCF3D, ZHLC_HRC3D, ZHLC_LRC3D, ZHLI_HCF3D, ZHLI_LCF3D, ZHLI_HRI3D, ZHLI_LRI3D )
   ZHLC_HCF3D(:,:,:)=0.
   ZHLC_LCF3D(:,:,:)=0.
   ZHLC_HRC3D(:,:,:)=0.
@@ -1899,7 +1913,7 @@ IF(IMICRO>0) THEN
   END DO
 !$acc end kernels
 ELSE
-!$acc kernels
+!$acc kernels present_cr( PRAINFR, ZHLC_HCF3D, ZHLC_LCF3D, ZHLC_HRC3D, ZHLC_LRC3D, ZHLI_HCF3D, ZHLI_LCF3D, ZHLI_HRI3D, ZHLI_LRI3D, PCIT )
   PRAINFR(:,:,:)=0.
   ZHLC_HCF3D(:,:,:)=0.
   ZHLC_LCF3D(:,:,:)=0.
@@ -1912,7 +1926,7 @@ ELSE
   PCIT(:,:,:) = 0.
 !$acc end kernels
 ENDIF
-!$acc kernels
+!$acc kernels present_cr( PEVAP3D )
 IF(OWARM) THEN
   PEVAP3D(:,:,:) = 0.
 !$acc loop independent
@@ -2685,7 +2699,6 @@ CONTAINS
   REAL,    DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZW
 #endif
   !
-!$acc data present( PRV, PRC, PRR, PRI, PRS, PRG, PTH, PLVFACT, PLSFACT, PRH )
   !
   IF (MPPDB_INITIALIZED) THEN
     !Check all IN arrays
@@ -2702,6 +2715,8 @@ CONTAINS
     CALL MPPDB_CHECK(PTH,"CORRECT_NEGATIVITIES beg:PTH")
   END IF
 
+!$acc data present( PRV, PRC, PRR, PRI, PRS, PRG, PTH, PLVFACT, PLSFACT )
+
 #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 ) ) )
@@ -2750,6 +2765,7 @@ CONTAINS
   ENDDO
 
   IF(KRR==7) THEN
+!$acc data present( PRH )
     DO JK = 1, KKT
       DO JJ = 1, KJT
         DO JI = 1, KIT
@@ -2760,6 +2776,7 @@ CONTAINS
         ENDDO
       ENDDO
     ENDDO
+!$acc end data
   ENDIF
 
   ! 2) deal with negative vapor mixing ratio
@@ -2797,6 +2814,7 @@ CONTAINS
   ENDDO
 
   IF(KRR==7) THEN
+!$acc data present( PRH )
     DO JK = 1, KKT
       DO JJ = 1, KJT
         DO JI = 1, KIT
@@ -2808,6 +2826,7 @@ CONTAINS
         ENDDO
       ENDDO
     ENDDO
+!$acc end data
   ENDIF
 !$acc end kernels
 
@@ -2818,6 +2837,8 @@ CONTAINS
   CALL MNH_MEM_RELEASE()
 #endif
 
+!$acc end data
+
   IF (MPPDB_INITIALIZED) THEN
     !Check all INOUT arrays
     CALL MPPDB_CHECK(PRV,"CORRECT_NEGATIVITIES end:PRV")
@@ -2830,8 +2851,6 @@ CONTAINS
     CALL MPPDB_CHECK(PTH,"CORRECT_NEGATIVITIES end:PTH")
   END IF
 
-!$acc end data
-
   END SUBROUTINE CORRECT_NEGATIVITIES
 !
 END SUBROUTINE RAIN_ICE_RED
-- 
GitLab