From 9a2ec7e3d70891298689d462eb8913944381d4f4 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Wed, 26 Jan 2022 10:02:16 +0100
Subject: [PATCH] Philippe 26/01/2022: OpenACC: workaround CCE compiler
problem: report modifications in ZSOLVER directory
---
src/ZSOLVER/advection_metsv.f90 | 9 ++++---
src/ZSOLVER/advecuvw_rk.f90 | 47 ++++++++++++++++++---------------
src/ZSOLVER/turb.f90 | 25 ++++++++++++------
3 files changed, 49 insertions(+), 32 deletions(-)
diff --git a/src/ZSOLVER/advection_metsv.f90 b/src/ZSOLVER/advection_metsv.f90
index 058b0e18f..bda429f84 100644
--- a/src/ZSOLVER/advection_metsv.f90
+++ b/src/ZSOLVER/advection_metsv.f90
@@ -327,6 +327,7 @@ TYPE(TFIELDDATA) :: TZFIELD
!
INTEGER :: JIU,JJU,JKU
INTEGER :: JK
+REAL :: ZIBM_EPSI !Intermediate variable used to work around a Cray compiler bug (CCE 13.0.0)
!-------------------------------------------------------------------------------
!$acc data present( PUT, PVT, PWT, PTHT, PTKET, PRHODJ, PPABST, PRT, PSVT, PTHVREF, &
!$acc & PDXX, PDYY, PDZZ, PDZX, PDZY, PRTHS, PRTKES, PRRS, PRSVS, PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
@@ -471,6 +472,8 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IKB=1+JPVEXT
IKE=SIZE(PSVT,3) - JPVEXT
+ZIBM_EPSI = XIBM_EPSI
+
#ifdef MNH_OPENACC
CALL INIT_ON_HOST_AND_DEVICE(PRTKES_ADV,PVALUE=-1e99,HNAME='ADVECTION_METSV::PRTKES_ADV')
CALL INIT_ON_HOST_AND_DEVICE(ZRUCPPM,PVALUE=-1e90,HNAME='ADVECTION_METSV::ZRUCPPM')
@@ -568,9 +571,9 @@ IF (.NOT. L1D) THEN
ZCFLW(IIB:IIE,IJB:IJE,:) = ZCFLW(IIB:IIE,IJB:IJE,:)*(1.-Br_exp(-Br_pow(XIBM_LS(IIB:IIE,IJB:IJE,:,4)/&
Br_pow(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:),1./3.),2.)))
#endif
- WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,2).GT.(-XIBM_EPSI)) ZCFLU(IIB:IIE,IJB:IJE,:)=0.
- WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,3).GT.(-XIBM_EPSI)) ZCFLV(IIB:IIE,IJB:IJE,:)=0.
- WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,4).GT.(-XIBM_EPSI)) ZCFLW(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,2).GT.(-ZIBM_EPSI)) ZCFLU(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,3).GT.(-ZIBM_EPSI)) ZCFLV(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,4).GT.(-ZIBM_EPSI)) ZCFLW(IIB:IIE,IJB:IJE,:)=0.
!$acc end kernels
ENDIF
#ifndef MNH_BITREP
diff --git a/src/ZSOLVER/advecuvw_rk.f90 b/src/ZSOLVER/advecuvw_rk.f90
index e08e0bddc..6a4b8117c 100644
--- a/src/ZSOLVER/advecuvw_rk.f90
+++ b/src/ZSOLVER/advecuvw_rk.f90
@@ -232,6 +232,8 @@ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS4_ll ! list of fields to exchange
!
+LOGICAL :: GIBM !Intermediate variable used to work around a Cray compiler bug (CCE 13.0.0)
+REAL :: ZIBM_EPSI !Intermediate variable used to work around a Cray compiler bug (CCE 13.0.0)
REAL :: ZTIME1,ZTIME2
!-------------------------------------------------------------------------------
!$acc data present( PU, PV, PW, PUT, PVT, PWT, PMXM_RHODJ, PMYM_RHODJ, PMZM_RHODJ, &
@@ -258,6 +260,9 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRWS_OTHER,"ADVECUVW_RK beg:PRWS_OTHER")
END IF
+GIBM = LIBM
+ZIBM_EPSI = XIBM_EPSI
+
#ifdef MNH_OPENACC
if ( LIBM ) call Print_msg( NVERB_FATAL, 'GEN', 'ADVECUVW_RK', 'OpenACC: LIBM=T not yet implemented' )
#endif
@@ -406,7 +411,7 @@ ALLOCATE(ZRVS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
ALLOCATE(ZRWS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
#endif
-IF ( LIBM ) THEN
+IF ( GIBM ) THEN
#ifndef MNH_OPENACC
ALLOCATE( ZIBM(SIZE(PUT,1), SIZE(PUT,2), SIZE(PWT,3), 3) )
#endif
@@ -415,15 +420,15 @@ IF ( LIBM ) THEN
!$acc end kernels
END IF
!
-!$acc kernels present(PRUS_ADV,PRVS_ADV,PRWS_ADV) present(ZUT,ZVT,ZWT) present(PU,PV,PW)
-IF (LIBM .AND. CIBM_ADV=='FREEZE') THEN
-
- WHERE (XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZIBM(:,:,:,1) = 0.
- WHERE (XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZIBM(:,:,:,2) = 0.
- WHERE (XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZIBM(:,:,:,3) = 0.
-
+IF (GIBM .AND. CIBM_ADV=='FREEZE') THEN
+!$acc kernels
+ WHERE (XIBM_LS(:,:,:,2).GT.-ZIBM_EPSI) ZIBM(:,:,:,1) = 0.
+ WHERE (XIBM_LS(:,:,:,3).GT.-ZIBM_EPSI) ZIBM(:,:,:,2) = 0.
+ WHERE (XIBM_LS(:,:,:,4).GT.-ZIBM_EPSI) ZIBM(:,:,:,3) = 0.
+!$acc end kernels
ENDIF
!
+!$acc kernels present(PRUS_ADV,PRVS_ADV,PRWS_ADV) present(ZUT,ZVT,ZWT) present(PU,PV,PW)
PRUS_ADV = 0.
PRVS_ADV = 0.
PRWS_ADV = 0.
@@ -498,13 +503,13 @@ RKLOOP: DO JS = 1, ISPL
!* 4. Advection with WENO
! --------------------------
!
+ IF (GIBM .AND. CIBM_ADV=='LOWORD') THEN
!$acc kernels
- IF (LIBM .AND. CIBM_ADV=='LOWORD') THEN
ZIBM(:,:,:,1)=ZRUS(:,:,:,JS)
ZIBM(:,:,:,2)=ZRVS(:,:,:,JS)
ZIBM(:,:,:,3)=ZRWS(:,:,:,JS)
- ENDIF
!$acc end kernels
+ ENDIF
!
!!$TZHALO2_UT => TZHALO2MT_ll ! 1rst add3dfield in model_n
!!$TZHALO2_VT => TZHALO2MT_ll%NEXT ! 2nd add3dfield in model_n
@@ -527,7 +532,7 @@ RKLOOP: DO JS = 1, ISPL
TZHALO2MT_ll )
ENDIF
!
- IF (LIBM .AND. CIBM_ADV=='LOWORD') THEN
+ IF (GIBM .AND. CIBM_ADV=='LOWORD') THEN
IF (HUVW_ADV_SCHEME=='WENO_K') THEN
CALL ADVECUVW_WENO_K (HLBCX, HLBCY, 3, ZUT, ZVT, ZWT, &
PRUCT, PRVCT, PRWCT, &
@@ -543,9 +548,9 @@ RKLOOP: DO JS = 1, ISPL
CALL ADVECUVW_2ND (ZUT, ZVT, ZWT, PRUCT, PRVCT, PRWCT, &
ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3))
ENDIF
- WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZRUS(:,:,:,JS)=ZIBM(:,:,:,1)
- WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZRVS(:,:,:,JS)=ZIBM(:,:,:,2)
- WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZRWS(:,:,:,JS)=ZIBM(:,:,:,3)
+ WHERE(XIBM_LS(:,:,:,2).GT.-ZIBM_EPSI) ZRUS(:,:,:,JS)=ZIBM(:,:,:,1)
+ WHERE(XIBM_LS(:,:,:,3).GT.-ZIBM_EPSI) ZRVS(:,:,:,JS)=ZIBM(:,:,:,2)
+ WHERE(XIBM_LS(:,:,:,4).GT.-ZIBM_EPSI) ZRWS(:,:,:,JS)=ZIBM(:,:,:,3)
ZIBM(:,:,:,:)=1.
ENDIF
!
@@ -564,13 +569,13 @@ RKLOOP: DO JS = 1, ISPL
! acc update device(ZRUS(:,:,:,JS),ZRVS(:,:,:,JS),ZRWS(:,:,:,JS))
#endif
!
- IF (LIBM .AND. CIBM_ADV=='FREEZE') THEN
- WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZRUS(:,:,:,JS)=ZUT(:,:,:)*PMXM_RHODJ(:,:,:)/PTSTEP
- WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZRVS(:,:,:,JS)=ZVT(:,:,:)*PMYM_RHODJ(:,:,:)/PTSTEP
- WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZRWS(:,:,:,JS)=ZWT(:,:,:)*PMZM_RHODJ(:,:,:)/PTSTEP
+ IF (GIBM .AND. CIBM_ADV=='FREEZE') THEN
+ WHERE(XIBM_LS(:,:,:,2).GT.-ZIBM_EPSI) ZRUS(:,:,:,JS)=ZUT(:,:,:)*PMXM_RHODJ(:,:,:)/PTSTEP
+ WHERE(XIBM_LS(:,:,:,3).GT.-ZIBM_EPSI) ZRVS(:,:,:,JS)=ZVT(:,:,:)*PMYM_RHODJ(:,:,:)/PTSTEP
+ WHERE(XIBM_LS(:,:,:,4).GT.-ZIBM_EPSI) ZRWS(:,:,:,JS)=ZWT(:,:,:)*PMZM_RHODJ(:,:,:)/PTSTEP
ENDIF
- IF (LIBM .AND. CIBM_ADV=='FORCIN') THEN
+ IF (GIBM .AND. CIBM_ADV=='FORCIN') THEN
CALL SECOND_MNH(ZTIME1)
CALL IBM_FORCING_ADV(ZRUS(:,:,:,JS),ZRVS(:,:,:,JS),ZRWS(:,:,:,JS))
CALL SECOND_MNH(ZTIME2)
@@ -580,7 +585,7 @@ RKLOOP: DO JS = 1, ISPL
! Guesses at the end of the RK loop
!
!$acc kernels present(PRUS_ADV,PRVS_ADV,PRWS_ADV,ZBUTS) present(ZRUS,ZRVS,ZRWS,ZIBM)
- IF ( .NOT. LIBM ) THEN
+ IF ( .NOT. GIBM ) THEN
PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JS) * ZRUS(:,:,:,JS)
PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JS) * ZRVS(:,:,:,JS)
PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JS) * ZRWS(:,:,:,JS)
@@ -604,7 +609,7 @@ RKLOOP: DO JS = 1, ISPL
!
! Intermediate guesses inside the RK loop
!
- IF ( .NOT. LIBM ) THEN
+ IF ( .NOT. GIBM ) THEN
ZUT(:,:,:) = ZUT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
( ZRUS(:,:,:,JI) + PRUS_OTHER(:,:,:) ) / PMXM_RHODJ(:,:,:)
ZVT(:,:,:) = ZVT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
diff --git a/src/ZSOLVER/turb.f90 b/src/ZSOLVER/turb.f90
index bb9d6007e..66b8ae380 100644
--- a/src/ZSOLVER/turb.f90
+++ b/src/ZSOLVER/turb.f90
@@ -483,6 +483,7 @@ INTEGER :: IZTMP1_DEVICE,IZTMP2_DEVICE,IZTMP3_DEVICE
!
INTEGER :: JIU,JJU,JKU
INTEGER :: JLU_ZRM, JLU_TURB, JJU_ORMC01, JKU_CLOUD, JKU_TURB
+LOGICAL :: GOCEAN !Intermediate variable used to work around a Cray compiler bug (CCE 13.0.0)
!
!------------------------------------------------------------------------------------------
!
@@ -716,6 +717,8 @@ IKE=KKU-JPVEXT_TURB*KKL
ZEXPL = 1.- PIMPL
ZRVORD= XRV / XRD
!
+GOCEAN = LOCEAN
+!
!
!$acc update device(PTHLT,PRT)
!$acc kernels
@@ -750,7 +753,7 @@ END DO
!
!* 2.2 Exner function at t
!
-IF (LOCEAN) THEN
+IF (GOCEAN) THEN
ZEXN(:,:,:) = 1.
ELSE
!PW: "BUG" PGI : results different on CPU and GPU due to the power function
@@ -1514,8 +1517,8 @@ IF (LLES_CALL) THEN
!$acc end kernels
CALL LES_MEAN_SUBGRID(ZTMP1_DEVICE,X_LES_SUBGRID_U2)
!$acc kernels
- X_LES_SUBGRID_V2 = X_LES_SUBGRID_U2
- X_LES_SUBGRID_W2 = X_LES_SUBGRID_U2
+ X_LES_SUBGRID_V2(:,:,:) = X_LES_SUBGRID_U2(:,:,:)
+ X_LES_SUBGRID_W2(:,:,:) = X_LES_SUBGRID_U2(:,:,:)
!$acc end kernels
CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLT,PDZZ,ZTMP2_DEVICE)
CALL MZF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
@@ -2124,6 +2127,7 @@ LOGICAL, INTENT(IN) :: ODZ
!
integer :: ji, jj, jk
+LOGICAL :: GOCEAN !Intermediate variable used to work around a Cray compiler bug (CCE 13.0.0)
REAL :: ZALPHA ! proportionnality constant between Dz/2 and
! ! BL89 mixing length near the surface
REAL :: ZD ! distance to the surface
@@ -2148,6 +2152,8 @@ allocate( ztmp1_device( size( pdxx, 1 ), size( pdxx, 2 ), size( pdxx, 3 ) ) )
allocate( ztmp2_device( size( pdxx, 1 ), size( pdxx, 2 ), size( pdxx, 3 ) ) )
#endif
+GOCEAN = LOCEAN
+
!$acc data create( ztmp1_device, ztmp2_device )
IF (ODZ) THEN
@@ -2237,7 +2243,7 @@ IF (.NOT. ORMC01) THEN
!
DO JJ=1,SIZE(PLM,2)
DO JI=1,SIZE(PLM,1)
- IF (LOCEAN) THEN
+ IF (GOCEAN) THEN
DO JK=KKTE,KKTB,-1
ZD=ZALPHA*(PZZ(JI,JJ,KKTE+1)-PZZ(JI,JJ,JK))
IF ( PLM(JI,JJ,JK)>ZD) THEN
@@ -2369,6 +2375,7 @@ REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZTMP1_DEVICE,ZTMP2_DEVICE
INTEGER :: IZTMP1_DEVICE,IZTMP2_DEVICE
#endif
INTEGER :: JIU,JJU,JKU
+LOGICAL :: GOCEAN !Intermediate variable used to work around a Cray compiler bug (CCE 13.0.0)
!----------------------------------------------------------------------------
!$acc data present( PDXX, PDYY, PDZZ, PZZ, PDIRCOSZW, PTHLT, PTHVREF, PTKET, PSRCT, PRT, PLOCPEXNM, PATHETA, PAMOIST, PLM )
@@ -2394,6 +2401,8 @@ JIU = size(pthlt, 1 )
JJU = size(pthlt, 2 )
JKU = size(pthlt, 3 )
+GOCEAN = LOCEAN
+
!-------------------------------------------------------------------------------
#ifndef MNH_OPENACC
allocate( ZWORK2D(JIU,JJU) )
@@ -2502,7 +2511,7 @@ IF (KRR>0) THEN
(PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
ZDRTDZ(JI,JJ,JK) = 0.5*((PRT(JI,JJ,JK+KKL,1)-PRT(JI,JJ,JK ,1))/PDZZ(JI,JJ,JK+KKL)+ &
(PRT(JI,JJ,JK ,1)-PRT(JI,JJ,JK-KKL,1))/PDZZ(JI,JJ,JK ))
- IF (LOCEAN) THEN
+ IF (GOCEAN) THEN
ZVAR=XG*(XALPHAOC*ZDTHLDZ(JI,JJ,JK)-XBETAOC*ZDRTDZ(JI,JJ,JK))
ELSE
ZVAR=XG/PTHVREF(JI,JJ,JK)* &
@@ -2523,7 +2532,7 @@ ELSE! For dry atmos or unsalted ocean runs
DO JI=1,SIZE(PLM,1)
ZDTHLDZ(JI,JJ,JK)= 0.5*((PTHLT(JI,JJ,JK+KKL)-PTHLT(JI,JJ,JK ))/PDZZ(JI,JJ,JK+KKL)+ &
(PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
- IF (LOCEAN) THEN
+ IF (GOCEAN) THEN
ZVAR= XG*XALPHAOC*ZDTHLDZ(JI,JJ,JK)
ELSE
ZVAR= XG/PTHVREF(JI,JJ,JK)*ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)
@@ -2546,7 +2555,7 @@ ELSE
ZDRTDZ(:,:,KKB)=0
ENDIF
!
-IF (LOCEAN) THEN
+IF (GOCEAN) THEN
#if 0
!PW: bug: crash with nvhpc 21.11 (OK with 21.9)
ZWORK2D(:,:)=XG*(XALPHAOC*ZDTHLDZ(:,:,KKB)-XBETAOC*ZDRTDZ(:,:,KKB))
@@ -2587,7 +2596,7 @@ IF (.NOT. ORMC01) THEN
!
DO JJ=1,SIZE(PLM,2)
DO JI=1,SIZE(PLM,1)
- IF (LOCEAN) THEN
+ IF (GOCEAN) THEN
DO JK=KKTE,KKTB,-1
ZD=ZALPHA*(PZZ(JI,JJ,KKTE+1)-PZZ(JI,JJ,JK))
IF ( PLM(JI,JJ,JK)>ZD) THEN
--
GitLab