From 03bc243bf31c5ef22abf73f4d0ba9239213faa83 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 21 Nov 2019 13:30:16 +0100
Subject: [PATCH] Philippe 21/11/2019: OpenACC: misc modifications
---
src/MNH/advecuvw_4th.f90 | 4 ++--
src/MNH/ppm.f90 | 44 ++++++++++++++++++++++++--------------
src/MNH/prandtl.f90 | 4 ----
src/MNH/resolved_cloud.f90 | 24 ++++++++++++++++++---
src/MNH/turb.f90 | 24 +++++++++++++--------
src/MNH/ver_interp_lin.f90 | 15 ++++++-------
6 files changed, 72 insertions(+), 43 deletions(-)
diff --git a/src/MNH/advecuvw_4th.f90 b/src/MNH/advecuvw_4th.f90
index 6f4b11db6..c7dc02979 100644
--- a/src/MNH/advecuvw_4th.f90
+++ b/src/MNH/advecuvw_4th.f90
@@ -220,9 +220,9 @@ INTEGER :: IGRID ! localisation on the model grid
#ifndef MNH_OPENACC
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMEANX, ZMEANY ! fluxes
#else
-REAL, DIMENSION(IIU,IJU,IKU) :: ZMEANX, ZMEANY ! fluxes
+REAL, DIMENSION(:,:,:) :: ZMEANX, ZMEANY ! fluxes
!
-REAL, DIMENSION(IIU,IJU,IKU) :: ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4
+REAL, DIMENSION(:,:,:) :: ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4
INTEGER :: II
#endif
diff --git a/src/MNH/ppm.f90 b/src/MNH/ppm.f90
index b9428787f..c122536c1 100644
--- a/src/MNH/ppm.f90
+++ b/src/MNH/ppm.f90
@@ -2536,25 +2536,29 @@ INTEGER:: IIE,IJE ! End useful area in x,y,z directions
INTEGER :: IJS,IJN
!
LOGICAL :: GWEST, GEAST
-#endif
+
! advection fluxes
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
!
! variable at cell edges
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
!
-!BEG JUAN PPM_LL
-TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
-!END JUAN PPM_LL
+REAL, DIMENSION(SIZE(PCR,2),SIZE(PCR,3)) :: ZPSRC_HALO2_WEST
+#else
+! advection fluxes
+REAL, DIMENSION(:,:,:) :: ZFPOS, ZFNEG
!
-#ifdef _OPENACC
-!JUAN ACC
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRHO_MXM, ZCR_MXM , ZCR_DXF
-INTEGER :: I,J,K
+! variable at cell edges
+REAL, DIMENSION(:,:,:) :: ZPHAT
!
-!JUAN ACC
+REAL, DIMENSION(:,:,:) :: ZRHO_MXM, ZCR_MXM , ZCR_DXF
+INTEGER :: I,J,K
+!
+REAL, DIMENSION(:,:) :: ZPSRC_HALO2_WEST
#endif
-REAL, DIMENSION(SIZE(PCR,2),SIZE(PCR,3)) :: ZPSRC_HALO2_WEST
+
+TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
+
!-------------------------------------------------------------------------------
!$acc data present( PSRC, PCR, PRHO, PR , &
@@ -2968,7 +2972,6 @@ INTEGER :: IJS,IJN
INTEGER :: IIW,IIA
!
LOGICAL :: GNORTH, GSOUTH
-#endif
!
! advection fluxes
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
@@ -2976,18 +2979,27 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
! variable at cell edges
REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
!
-!BEG JUAN PPM_LL
TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
TYPE(HALO2LIST_ll), POINTER :: TZ_PHAT_HALO2_ll ! halo2 for ZPHAT
-!END JUAN PPM_LL
-#ifdef _OPENACC
!
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRHO_MYM , ZCR_MYM , ZCR_DYF
+REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,3)) :: ZPSRC_HALO2_SOUTH
+#else
+!
+! advection fluxes
+REAL, DIMENSION(:,:,:) :: ZFPOS, ZFNEG
+!
+! variable at cell edges
+REAL, DIMENSION(:,:,:) :: ZPHAT
+!
+TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
+TYPE(HALO2LIST_ll), POINTER :: TZ_PHAT_HALO2_ll ! halo2 for ZPHAT
+!
+REAL, DIMENSION(:,:,:) :: ZRHO_MYM , ZCR_MYM , ZCR_DYF
!
INTEGER :: I,J,K
!
+REAL, DIMENSION(:,:) :: ZPSRC_HALO2_SOUTH
#endif
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,3)) :: ZPSRC_HALO2_SOUTH
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index 2c6f15209..b5d267575 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.f90
@@ -471,10 +471,6 @@ END DO
!
IF(HTURBDIM=='1DIM') THEN ! 1D case
!
-#ifdef MNH_OPENACC
-call Print_msg( NVERB_WARNING, 'GEN', 'PRANDTL', 'OpenACC: 1DIM not yet tested' )
-#endif
-!
!$acc kernels async
#ifndef MNH_BITREP
PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 55d8b32ba..5a9111c4f 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -441,7 +441,7 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
! Variables from modules
-!$acc declare copyin(CSEDIM)
+! !$acc declare copyin(CSEDIM)
!
!* 0.2 Declarations of local variables :
!
@@ -762,14 +762,32 @@ END IF
SELECT CASE ( HCLOUD )
CASE('KESS')
#ifdef MNH_OPENACC
-CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','KESS not yet implemented')
+CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
#endif
+#ifndef MNH_OPENACC
WHERE (PRS(:,:,:,2) < 0.)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
ZCPH(:,:,:) / PEXNREF(:,:,:)
PRS(:,:,:,2) = 0.0
END WHERE
+#else
+!$acc kernels
+!$acc loop independent collapse(3)
+ DO JK=1,SIZE(PRS,3)
+ DO JJ=1,SIZE(PRS,2)
+ DO JI=1,SIZE(PRS,1)
+ IF (PRS(JI,JJ,JK,2) < 0.) THEN
+ PRS(JI, JJ, JK , 1) = PRS(JI, JJ, JK , 1) + PRS(JI, JJ, JK , 2)
+ PTHS(JI, JJ, JK ) = PTHS(JI, JJ, JK ) - PRS(JI, JJ, JK , 2) * ZLV(JI, JJ, JK ) &
+ / ZCPH(JI, JJ, JK ) / PEXNREF(JI, JJ, JK )
+ PRS(JI, JJ, JK , 2) = 0.0
+ END IF
+ END DO
+ END DO
+ END DO
+!$acc end kernels
+#endif
!
!
! CASE('C2R2','KHKO')
@@ -1089,7 +1107,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','REVE not yet implemented')
!
CASE ('KESS')
#ifdef MNH_OPENACC
-CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','KESS not yet implemented')
+CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
#endif
!
!* 5. KESSLER MICROPHYSICAL SCHEME
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index 921cdd662..3a39fea0a 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -762,10 +762,9 @@ SELECT CASE (HTURBLEN)
! ------------------
CASE ('BL89')
-#ifdef MNH_OPENACC
- call Print_msg( NVERB_FATAL, 'GEN', 'TURB', 'OpenACC: HTURBLEN=BL89 not yet implemented' )
-#endif
+!$acc kernels
ZSHEAR(:, :, : ) = 0.
+!$acc end kernels
CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
!
!* 3.2 RM17 mixing length
@@ -1248,7 +1247,6 @@ IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
- ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZTT(:,:,:)-XTT)
ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
! CALL GET_HALO(PRRS(:,:,:,2))
! CALL GET_HALO(PRSVS(:,:,:,2))
@@ -1461,6 +1459,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PUSLOPE,PVSLOPE
INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
+logical :: gwest, geast, gnorth, gsouth
!
!* 1 PROLOGUE
!
@@ -1489,20 +1488,25 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!
! 3 Boundary conditions for non cyclic case
!
+gwest = HLBCX(1) /= "CYCL" .AND. LWEST_ll()
+geast = HLBCX(2) /= "CYCL" .AND. LEAST_ll()
+gsouth = HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()
+gnorth = HLBCY(2) /= "CYCL" .AND. LNORTH_ll()
+
!$acc kernels
-IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+IF ( gwest ) THEN
PUSLOPE(IIB-1,:)=PUSLOPE(IIB,:)
PVSLOPE(IIB-1,:)=PVSLOPE(IIB,:)
END IF
-IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+IF ( geast ) THEN
PUSLOPE(IIE+1,:)=PUSLOPE(IIE,:)
PVSLOPE(IIE+1,:)=PVSLOPE(IIE,:)
END IF
-IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+IF ( gsouth ) THEN
PUSLOPE(:,IJB-1)=PUSLOPE(:,IJB)
PVSLOPE(:,IJB-1)=PVSLOPE(:,IJB)
END IF
-IF( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+IF ( gnorth ) THEN
PUSLOPE(:,IJE+1)=PUSLOPE(:,IJE)
PVSLOPE(:,IJE+1)=PVSLOPE(:,IJE)
END IF
@@ -1742,7 +1746,9 @@ ELSE
!* 3.1 BL89 mixing length
! ------------------
CASE ('BL89','RM17')
+!$acc kernels
ZSHEAR(:, :, : ) = 0.
+!$acc end kernels
CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD)
!
!* 3.2 Delta mixing length
@@ -2073,7 +2079,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTMP1_DEVICE,ZTMP2_DEVICE
#endif
!----------------------------------------------------------------------------
-!$acc data present( PDXX, PDYY, PDZZ, PZZ, PDIRCOSZW, PTHLT, PTHVREF, PTKET, PSRCT, PRT, PLOCPEXNM, PLM )
+!$acc data present( PDXX, PDYY, PDZZ, PZZ, PDIRCOSZW, PTHLT, PTHVREF, PTKET, PSRCT, PRT, PLOCPEXNM, PATHETA, PAMOIST, PLM )
if ( mppdb_initialized ) then
!Check all in arrays
diff --git a/src/MNH/ver_interp_lin.f90 b/src/MNH/ver_interp_lin.f90
index 50fad7ee5..d426392a7 100644
--- a/src/MNH/ver_interp_lin.f90
+++ b/src/MNH/ver_interp_lin.f90
@@ -259,15 +259,12 @@ IMPLICIT NONE
!
!* 0.1 Declaration of arguments
! ------------------------
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
-! ! grid
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR1 ! variable values on the initial grid
INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
-! ! grid 1 for each level of grid 2
+! ! grid 1 for each level of grid 2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
!
-REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2),SIZE(KKLIN,3)), INTENT(OUT) &
- :: PVAR2 ! variable values on target
-! ! grid
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVAR2 ! variable values on target grid
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -276,6 +273,7 @@ INTEGER :: JI,JJ,JK2
!-------------------------------------------------------------------------------
!
call Print_msg( NVERB_WARNING, 'GEN', 'VER_INTERP_LIN3D_DEVICE', 'OpenACC: not yet tested' )
+
!$acc data present(PVAR1,KKLIN,PCOEFLIN,PVAR2)
!$acc kernels
DO JK2=1,SIZE(KKLIN,3)
@@ -434,8 +432,7 @@ INTEGER,DIMENSION(:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
! ! grid 1 for each level of grid 2
REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
!
-REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2)), INTENT(OUT) :: PVAR2 ! variable values on
-! ! target grid
+REAL, DIMENSION(:,:), INTENT(OUT) :: PVAR2 ! variable values on target grid
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -616,7 +613,7 @@ INTEGER,DIMENSION(:), INTENT(IN) :: KKLIN ! lower interpolating level of
! ! grid 1 for each level of grid 2
REAL, DIMENSION(:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
-REAL, DIMENSION(SIZE(KKLIN)), INTENT(OUT) :: PVAR2 ! variable values on target
+REAL, DIMENSION(:), INTENT(OUT) :: PVAR2 ! variable values on target
! ! grid
!
!* 0.2 Declaration of local variables
--
GitLab