From 4561087445afa1b5346c989f80ebce3b5cf4583e Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Thu, 18 Jul 2019 16:28:01 +0200
Subject: [PATCH] Philippe 18/07/2019: OpenACC: various developments
---
src/MNH/advec_4th_order_aux.f90 | 17 ++--
src/MNH/advec_weno_k_2_aux.f90 | 5 +-
src/MNH/advection_uvw_cen.f90 | 3 -
src/MNH/advecuvw_4th.f90 | 144 +++++++++++++-------------------
src/MNH/prandtl.f90 | 3 -
src/MNH/turb_hor_dyn_corr.f90 | 5 --
src/MNH/turb_hor_vw.f90 | 4 +-
7 files changed, 73 insertions(+), 108 deletions(-)
diff --git a/src/MNH/advec_4th_order_aux.f90 b/src/MNH/advec_4th_order_aux.f90
index 6352bb536..4313d08eb 100644
--- a/src/MNH/advec_4th_order_aux.f90
+++ b/src/MNH/advec_4th_order_aux.f90
@@ -159,7 +159,6 @@ END IF
! ------------------------------
!
#ifdef _OPENACC
-call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_4TH_ORDER_ALGO', 'OpenACC: not yet tested' )
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_WEST,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_WEST')
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_EAST,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_EAST')
CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_SOUTH,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_SOUTH')
@@ -243,9 +242,6 @@ ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
!
CASE ('OPEN','WALL','NEST')
!
-#ifdef _OPENACC
-call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_4TH_ORDER_ALGO', 'OpenACC: HLBCX(1) AND OPEN/WALL/NEST not yet tested' )
-#endif
ZHALO2_WEST(:,:) = TPHALO2%WEST(:,:)
ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
!$acc update device (ZHALO2_WEST,ZHALO2_EAST)
@@ -374,9 +370,6 @@ ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
!
CASE ('OPEN','WALL','NEST')
!
-#ifdef _OPENACC
-call Print_msg( NVERB_WARNING, 'GEN', 'ADVEC_4TH_ORDER_ALGO', 'OpenACC: HLBCX(2) AND OPEN/WALL/NEST not yet tested' )
-#endif
ZHALO2_SOUTH(:,:) = TPHALO2%SOUTH(:,:)
ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
!$acc update device (ZHALO2_SOUTH,ZHALO2_NORTH)
@@ -518,7 +511,8 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF4 ! result at mass
- ! localization
+ ! localization
+!$acc declare present(PA, PMZF4)
!
!* 0.2 Declarations of local variables
!
@@ -546,6 +540,7 @@ IIJU = IIU*IJU
JIJKOR1 = 1 + IIJU
JIJKEND1 = 2*IIJU
!
+!$acc kernels
!CDIR NODEP
!OCL NOVREC
DO JIJK=JIJKOR1 , JIJKEND1
@@ -576,6 +571,7 @@ END DO
DO JIJ=1,IIJU
PMZF4(JIJ,1,IKU) = -999.
END DO
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
@@ -638,7 +634,8 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
! localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM4 ! result at flux
- ! localization
+ ! localization
+!$acc declare present(PA, PMZM4)
!
!* 0.2 Declarations of local variables
!
@@ -665,6 +662,7 @@ IIJU = IIU*IJU
JIJKOR1 = 1 + IIJU
JIJKEND1 = JIJKOR1 + IIJU
!
+!$acc kernels
!CDIR NODEP
!OCL NOVREC
DO JIJK=JIJKOR1 , JIJKEND1
@@ -692,6 +690,7 @@ END DO
DO JIJ=1,IIJU
PMZM4(JIJ,1,1) = -999.
END DO
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/advec_weno_k_2_aux.f90 b/src/MNH/advec_weno_k_2_aux.f90
index c09e52857..d6dfbe12a 100644
--- a/src/MNH/advec_weno_k_2_aux.f90
+++ b/src/MNH/advec_weno_k_2_aux.f90
@@ -753,8 +753,9 @@ REAL, PARAMETER :: ZEPS = 1.0E-15
!
!-------------------------------------------------------------------------------
IF (MPPDB_INITIALIZED) THEN
- !Check all OUT arrays
- CALL MPPDB_CHECK(PR,"ADVEC_WENO_K_2_MX end:PR")
+ !Check all IN arrays
+ CALL MPPDB_CHECK(PSRC, "ADVEC_WENO_K_2_MX beg:PSRC")
+ CALL MPPDB_CHECK(PRUCT,"ADVEC_WENO_K_2_MX beg:PRUCT")
END IF
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
index 9cc640dfb..4f14058c6 100644
--- a/src/MNH/advection_uvw_cen.f90
+++ b/src/MNH/advection_uvw_cen.f90
@@ -196,9 +196,6 @@ INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! index values for the physical subdomain
INTEGER :: IZ1, IZ2
#endif
!
-#ifdef _OPENACC
-call Print_msg( NVERB_WARNING, 'GEN', 'ADVECTION_UVW_CEN', 'OpenACC: not yet tested' )
-#endif
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/advecuvw_4th.f90 b/src/MNH/advecuvw_4th.f90
index a08f06bd1..5e14c7844 100644
--- a/src/MNH/advecuvw_4th.f90
+++ b/src/MNH/advecuvw_4th.f90
@@ -180,13 +180,12 @@ USE MODD_PARAMETERS
USE MODE_ll
use mode_mppdb
-#ifdef _OPENACC
-use mode_msg
-#endif
USE MODI_ADVEC_4TH_ORDER_AUX
#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
#endif
!
IMPLICIT NONE
@@ -237,7 +236,7 @@ REAL, DIMENSION(IIU,IJU,IKU) :: ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4
INTEGER :: II
#endif
!
-#ifdef _OPENACC
+#if 0
#define dxm(PDXM,PA) PDXM(2:IIU,:,:) = PA(2:IIU,:,:) - PA(1:IIU-1,:,:) ; PDXM(1,:,:) = PDXM(IIU-2*JPHEXT+1,:,:) ! DXM(PDXM,PA)
#define mxf(PMXF,PA) PMXF(1:IIU-1,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXF(IIU,:,:) = PMXF(2*JPHEXT,:,:) ! MXF(PMXF,PA)
#define mxm(PMXM,PA) PMXM(2:IIU,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXM(1,:,:) = PMXM(IIU-2*JPHEXT+1,:,:) ! MXM(PMXM,PA)
@@ -256,9 +255,6 @@ INTEGER :: II
PMZF4(:,:,1) = 0.5*( PA(:,:,2)+PA(:,:,1) ) ; PMZF4(:,:,IKU-1) = 0.5*( PA(:,:,IKU)+PA(:,:,IKU-1) ) ; PMZF4(:,:,IKU) = -999.
#endif
!
-#ifdef _OPENACC
-call Print_msg( NVERB_WARNING, 'GEN', 'ADVECUVW_4TH', 'OpenACC: not yet tested' )
-#endif
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
@@ -307,41 +303,33 @@ PRUS(:,:,:) = PRUS(:,:,:) &
PRUS(:,:,:) = PRUS(:,:,:) &
-DZF(1,IKU,1, MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
#else
-! pcopy(prus) pcopyin(pruct,ZMEANX) create(ZTEMP1,ZTEMP2,ZTEMP3)
-!!$PRUS(:,:,:) = PRUS(:,:,:) &
-!!$ -DXM( MXF(PRUCT(:,:,:))*ZMEANX(:,:,:) )
-
-!$acc kernels present(ZMEANX) present(PRUS)
-mxf(ZTEMP1,PRUCT)
+call mxf_device(PRUCT,ZTEMP1)
+!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
-dxm(ZTEMP3,ZTEMP2)
+!$acc end kernels
+call dxm_device(ZTEMP2,ZTEMP3)
+!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
-!$acc end kernels
-
+!$acc end kernels
!
-
-!!$PRUS(:,:,:) = PRUS(:,:,:) &
-!!$ -DYF( MXM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
-
-!$acc kernels present(ZMEANY) present(PRUS)
-mxm(ZTEMP1,PRVCT)
+call mxm_device(PRVCT,ZTEMP1)
+!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
-dyf(ZTEMP3,ZTEMP2)
+!$acc end kernels
+call dyf_device(ZTEMP2,ZTEMP3)
+!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
-!$acc end kernels
-
+!$acc end kernels
!
-
-!!$PRUS(:,:,:) = PRUS(:,:,:) &
-!!$ -DZF( MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
-
-!$acc kernels present(PUT,PRUS)
-mzm4(ZTEMP1,PUT)
-mxm(ZTEMP2,PRWCT)
+ZTEMP1 = MZM4( PUT )
+call mxm_device(PRWCT,ZTEMP2)
+!$acc kernels
ZTEMP3 = ZTEMP1 * ZTEMP2
-dzf(ZTEMP4,ZTEMP3)
+!$acc end kernels
+call dzf_device(1,IKU,1,ZTEMP3,ZTEMP4)
+!$acc kernels
PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP4
-!$acc end kernels
+!$acc end kernels
#endif
!
!
@@ -364,42 +352,35 @@ PRVS(:,:,:) = PRVS(:,:,:) &
PRVS(:,:,:) = PRVS(:,:,:) &
-DZF(1,IKU,1, MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
#else
-!!$PRVS(:,:,:) = PRVS(:,:,:) &
-!!$ -DXF( MYM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
-
-!$acc kernels present(ZMEANX) present(PRVS)
-mym(ZTEMP1,PRUCT)
+call mym_device(PRUCT,ZTEMP1)
+!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
-dxf(ZTEMP3,ZTEMP2)
-PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
-!$acc end kernels
-
-
+!$acc end kernels
+call dxf_device(ZTEMP2,ZTEMP3)
+!$acc kernels
+PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
+!$acc end kernels
!
-
-!!$PRVS(:,:,:) = PRVS(:,:,:) &
-!!$ -DYM( MYF(PRVCT(:,:,:))*ZMEANY(:,:,:) )
-
-!$acc kernels present(ZMEANY) present(PRVS)
-myf(ZTEMP1,PRVCT)
+call myf_device(PRVCT,ZTEMP1)
+!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
-dym(ZTEMP3,ZTEMP2)
+!$acc end kernels
+call dym_device(ZTEMP2,ZTEMP3)
+!$acc kernels
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
-!$acc end kernels
-
+!$acc end kernels
!
-
-!!$PRVS(:,:,:) = PRVS(:,:,:) &
-!!$ -DZF( MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
-
-!$acc kernels present(PVT,PRVS)
-mym(ZTEMP1,PRWCT)
-mzm4(ZTEMP2,PVT)
+call mym_device(PRWCT,ZTEMP1)
+ZTEMP2 = MZM4( PVT )
+!$acc kernels
ZTEMP3 = ZTEMP1 * ZTEMP2
-dzf(ZTEMP4,ZTEMP3)
+!$acc end kernels
+call dzf_device(1,IKU,1,ZTEMP3,ZTEMP4)
+!$acc kernels
PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP4
!$acc end kernels
#endif
+CALL MPPDB_CHECK(PRUCT,"ADVECUVW_4TH 02: PRUCT")
!
!
IGRID = 4
@@ -422,38 +403,31 @@ PRWS(:,:,:) = PRWS(:,:,:) &
PRWS(:,:,:) = PRWS(:,:,:) &
-DZM(1,IKU,1, MZF(1,IKU,1,PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
#else
-!!$PRWS(:,:,:) = PRWS(:,:,:) &
-!!$ -DXF( MZM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
-
-!$acc kernels present(ZMEANX) present(PRWS)
-mzm(ZTEMP1,PRUCT)
+call mzm_device(PRUCT,ZTEMP1)
+!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANX
-dxf(ZTEMP3,ZTEMP2)
+!$acc end kernels
+call dxf_device(ZTEMP2,ZTEMP3)
+!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
!$acc end kernels
-
!
-
-!!$PRWS(:,:,:) = PRWS(:,:,:) &
-!!$ -DYF( MZM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
-
-!$acc kernels present(ZMEANY) present(PRWS)
-mzm(ZTEMP1,PRVCT)
+call mzm_device(PRVCT,ZTEMP1)
+!$acc kernels
ZTEMP2 = ZTEMP1 * ZMEANY
-dyf(ZTEMP3,ZTEMP2)
+!$acc end kernels
+call dyf_device(ZTEMP2,ZTEMP3)
+!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
!$acc end kernels
-
!
-
-!!$PRWS(:,:,:) = PRWS(:,:,:) &
-!!$ -DZM( MZF(PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
-
-!$acc kernels present(PWT,PRWS)
-mzf(ZTEMP1,PRWCT)
-mzf4(ZTEMP2,PWT)
-ZTEMP1 = ZTEMP1 * ZTEMP2
-dzm(ZTEMP4,ZTEMP1)
+call mzf_device(1,IKU,1,PRWCT,ZTEMP1)
+ZTEMP2 = MZF4( PWT )
+!$acc kernels
+ZTEMP1 = ZTEMP1 * ZTEMP2
+!$acc end kernels
+call dzm_device(1,IKU,1,ZTEMP1,ZTEMP4)
+!$acc kernels
PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP4
!$acc end kernels
#endif
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index b1cedba18..c1565caac 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.f90
@@ -472,9 +472,6 @@ call Print_msg( NVERB_WARNING, 'GEN', 'PRANDTL', 'OpenACC: 1DIM not yet tested'
ELSE IF (L2D) THEN ! 3D case in a 2D model
!
IF (KRR /= 0) THEN ! moist 3D case
-#ifdef _OPENACC
-call Print_msg( NVERB_WARNING, 'GEN', 'PRANDTL', 'OpenACC: L2D=.T. and KRR/=0 not yet tested' )
-#endif
#ifndef _OPENACC
#ifndef MNH_BITREP
PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
diff --git a/src/MNH/turb_hor_dyn_corr.f90 b/src/MNH/turb_hor_dyn_corr.f90
index 8f4de6488..1ab89d3f3 100644
--- a/src/MNH/turb_hor_dyn_corr.f90
+++ b/src/MNH/turb_hor_dyn_corr.f90
@@ -573,14 +573,9 @@ END IF
! Complete the U tendency
#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
-CALL MPPDB_CHECK3DM("before turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
- & PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
-
PRUS(:,:,:)=PRUS &
-DXM(PRHODJ * ZFLX / MXF(PDXX) ) &
+DZF(1,IKU,1, PDZX / MZM(1,IKU,1,PDXX) * MXM( MZM(1,IKU,1,PRHODJ*ZFLX) * PINV_PDZZ ) )
-CALL MPPDB_CHECK3DM("after turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
- & PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
ELSE
PRUS(:,:,:)=PRUS -DXM(PRHODJ * ZFLX / MXF(PDXX) )
END IF
diff --git a/src/MNH/turb_hor_vw.f90 b/src/MNH/turb_hor_vw.f90
index 641f760b4..8e8bb8953 100644
--- a/src/MNH/turb_hor_vw.f90
+++ b/src/MNH/turb_hor_vw.f90
@@ -194,7 +194,9 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) &
:: ZFLX,ZWORK
! work arrays
-!
+!$acc declare create(ZFLX)
+!$acc declare device_resident(ZWORK)
+!
!! REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZVPTV
INTEGER :: IKB,IKE,IKU
! Index values for the Beginning and End
--
GitLab