From b030d7ae46cd9cc7bdf8097b24de82dbe3a6dfa1 Mon Sep 17 00:00:00 2001
From: Juan ESCOBAR <juan.escobar@aero.obs-mip.fr>
Date: Tue, 7 Mar 2023 14:49:12 +0100
Subject: [PATCH] Juan 07/03/2023:slow_terms.f90, Bypass CRAY CCE/15.0.1
compiler bug => remove size(...) in kernels + use MNH_MEM_GET
---
src/MNH/slow_terms.f90 | 97 +++++++++++++++++++++++++++---------------
1 file changed, 63 insertions(+), 34 deletions(-)
diff --git a/src/MNH/slow_terms.f90 b/src/MNH/slow_terms.f90
index c962c7112..d26ffcbdf 100644
--- a/src/MNH/slow_terms.f90
+++ b/src/MNH/slow_terms.f90
@@ -166,9 +166,16 @@ USE MODD_PARAMETERS, only: JPVEXT
use mode_budget, only: Budget_store_init, Budget_store_end
use mode_mppdb
+#ifdef MNH_OPENACC
+ USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+#endif
#if defined(MNH_BITREP) || defined(MNH_BITREP_OMP)
use modi_bitrep
#endif
+#if defined(MNH_COMPILER_CCE) && defined(MNH_BITREP_OMP)
+!$mnh_undef(LOOP)
+!$mnh_undef(OPENACC)
+#endif
IMPLICIT NONE
!
@@ -213,19 +220,21 @@ INTEGER :: IKE ! the microphysical sources have to be computed
!
REAL :: ZTSPLITR ! Small time step for rain sedimentation
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT,ZW,ZW1,ZW2,ZW3,ZEXNT,ZDZZ ! Work arrays
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: G3D
+REAL, DIMENSION(:,:,:), POINTER,CONTIGUOUS :: ZT,ZW,ZW1,ZW2,ZW3,ZEXNT,ZDZZ ! Work arrays
+LOGICAL, DIMENSION(:,:,:), POINTER,CONTIGUOUS :: G3D
!
INTEGER :: JI,JJ,IC,JL ! loop control for packed array
+INTEGER :: JIU, JJU, JKU
!-------------------------------------------------------------------------------
+JIU = size(pzz,1)
+JJU = size(pzz,2)
+JKU = size(pzz,3)
+
!$acc data present( PZZ, PRHODJ, PRHODREF, PCLDFR, PTHT, PRVT, PRCT, PRRT, &
!$acc & PPABST, PTHS, PRVS, PRCS, PRRS, PINPRR, PINPRR3D, PEVAP3D )
-! !$acc & copyin( XC1RC, XC2RC, XC1RE, XC2RE, XCEXRA, XCEXRE, XCEXRS, XCEXVT, XCRA, XCRS, XDIVA, XTHCO, &
-! !$acc & XALPW, XBETAW, XGAMW, XCL, XCPD, XCPV, XLVTT, XMD, XMV, XP00, XRD, XRHOLW, XRV, XTT )
-
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PZZ, "SLOW_TERMS beg:PZZ")
@@ -247,16 +256,29 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PEVAP3D, "SLOW_TERMS beg:PEVAP3D")
END IF
-allocate( zt ( size(pzz,1), size(pzz,2), size(pzz,3) ) )
-allocate( zw ( size(pzz,1), size(pzz,2), size(pzz,3) ) )
-allocate( zw1 ( size(pzz,1), size(pzz,2), size(pzz,3) ) )
-allocate( zw2 ( size(pzz,1), size(pzz,2), size(pzz,3) ) )
-allocate( zw3 ( size(pzz,1), size(pzz,2), size(pzz,3) ) )
-allocate( zexnt( size(pzz,1), size(pzz,2), size(pzz,3) ) )
-allocate( zdzz ( size(pzz,1), size(pzz,2), size(pzz,3) ) )
-allocate( g3d ( size(prhodj,1), size(prhodj,2), size(prhodj,3) ) )
+#ifndef MNH_OPENACC
+allocate( zt ,JIU,JJU,JKU )
+allocate( zw ,JIU,JJU,JKU )
+allocate( zw1 ,JIU,JJU,JKU )
+allocate( zw2 ,JIU,JJU,JKU )
+allocate( zw3 ,JIU,JJU,JKU )
+allocate( zexnt,JIU,JJU,JKU )
+allocate( zdzz ,JIU,JJU,JKU )
+allocate( g3d )
+#else
+!Pin positions in the pools of MNH memory
+CALL MNH_MEM_POSITION_PIN()
+CALL MNH_MEM_GET( zt ,JIU,JJU,JKU )
+CALL MNH_MEM_GET( zw ,JIU,JJU,JKU )
+CALL MNH_MEM_GET( zw1 ,JIU,JJU,JKU )
+CALL MNH_MEM_GET( zw2 ,JIU,JJU,JKU )
+CALL MNH_MEM_GET( zw3 ,JIU,JJU,JKU )
+CALL MNH_MEM_GET( zexnt,JIU,JJU,JKU )
+CALL MNH_MEM_GET( zdzz ,JIU,JJU,JKU )
+CALL MNH_MEM_GET( g3d ,JIU,JJU,JKU )
+#endif
-!$acc data create( zt, zw, zw1, zw2, zw3, zexnt, zdzz, g3d )
+!$acc data present( zt, zw, zw1, zw2, zw3, zexnt, zdzz, g3d )
!
!* 1. COMPUTE THE LOOP BOUNDS AND EXNER FUNCTION
! ------------------------------------------
@@ -279,33 +301,24 @@ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:,
!
!* 2.1 time splitting loop initialization
!
-!$acc kernels
ZTSPLITR = PTSTEP / REAL(KSPLITR) ! Small time step
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!$acc kernels
!
ZW1(:,:,:) = PRRS(:,:,:) * PTSTEP
ZW2(:,:,:) = 0.
ZW3(:,:,:) = 0.
!
-#ifndef MNH_OPENACC
G3D(:,:,:)=.FALSE.
DO JK=IKE,1,-1
+ !$mnh_expand_where(JI=1:JIU,JJ=1:JJU)
WHERE( ZW1(:,:,JK)>0. .OR. G3D(:,:,JK+1) )
G3D(:,:,JK)=.TRUE.
END WHERE
+ !$mnh_end_expand_where()
END DO
-#else
-g3d(:, :, : ) = .false.
-do jk = ike, 1, -1
- do jj = 1, size(pzz,2)
- do ji = 1, size(pzz,1)
- if ( zw1(ji, jj, jk ) >0. .or. g3d(ji, jj, jk+1 ) ) then
- g3d(ji, jj, jk ) = .true.
- end if
- end do
- end do
-end do
-#endif
!
+!$mnh_expand_where(JI=1:JIU,JJ=1:JJU,JK=1:JKU)
WHERE (G3D(:,:,:))
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
ZW3(:,:,:) = PRHODREF(:,:,:) ** (XCEXRS-XCEXVT)
@@ -313,7 +326,9 @@ WHERE (G3D(:,:,:))
ZW3(:,:,:) = BR_POW( PRHODREF(:,:,:), XCEXRS - XCEXVT )
#endif
END WHERE
+!$mnh_end_expand_where()
!
+!$mnh_expand_where(JI=1:JIU,JJ=1:JJU)
WHERE (ZW1(:,:,IKE+1)>0.)
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
ZW2(:,:,IKE+1) = XCRS &
@@ -325,6 +340,7 @@ WHERE (ZW1(:,:,IKE+1)>0.)
* BR_POW( PRHODREF(:,:,IKE+1), XCEXRS - XCEXVT )
#endif
END WHERE
+!$mnh_end_expand_where()
!
!
!* 2.2 small time step integration
@@ -337,9 +353,7 @@ DO JN=1,KSPLITR
!
DO JK=IKE,IKB,-1
-!$acc loop collapse(2) independent
- DO JJ = 1,SIZE( ZW1,2)
- DO JI = 1,SIZE( ZW1,1)
+ !$mnh_do_concurrent(JI=1:JIU,JJ=1:JJU)
IF ( ( ZW1(JI,JJ,JK+1)>0. ) .AND. ( ZW1(JI,JJ,JK)>0. ) ) THEN
!
!* 2.2.2 compute the rain flux
@@ -360,9 +374,8 @@ DO JN=1,KSPLITR
( ZW2(JI,JJ,JK+1)-ZW2(JI,JJ,JK) ) / &
( ZDZZ(JI,JJ,JK) * PRHODREF(JI,JJ,JK) )
END IF
- END DO
- ENDDO
- ENDDO
+ !$mnh_end_do()
+ END DO
!
!* 2.2.4 compute the explicit accumulated precipitations
! -----------------------------------------------
@@ -378,6 +391,7 @@ END DO
!
PRRS(:,:,:) = ZW1(:,:,:) / PTSTEP
!$acc end kernels
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!* 2.5 budget storage
!
@@ -396,6 +410,7 @@ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', prrs(:,
!
!$acc kernels
G3D(:,:,:) = PRCT(:,:,:)>0.0 .AND. PRRT(:,:,:)>0.0 .AND. PRCS(:,:,:)>0.0
+!$mnh_expand_where(JI=1:JIU,JJ=1:JJU,JK=1:JKU)
WHERE ( G3D(:,:,:) )
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
ZW(:,:,:) = XCRA * PRCT(:,:,:) &
@@ -411,6 +426,7 @@ WHERE ( G3D(:,:,:) )
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
END WHERE
+!$mnh_end_expand_where()
!$acc end kernels
!
!* 3.2 budget storage
@@ -432,14 +448,17 @@ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:,
!$acc kernels
IF ( HSUBG_AUCV == 'CLFR' ) THEN
G3D(:,:,:) = PRCT(:,:,:)>0.0 .AND. PRCS(:,:,:)>0.0 .AND. PCLDFR(:,:,:)>0.0
+ !$mnh_expand_where(JI=1:JIU,JJ=1:JJU,JK=1:JKU)
WHERE ( G3D(:,:,:) )
ZW(:,:,:) = XC1RC * MAX(PRCT(:,:,:) /(PCLDFR(:,:,:)) - XC2RC / PRHODREF(:,:,:),0.)
ZW(:,:,:) = MIN ( (ZW(:,:,:)* PCLDFR(:,:,:)), PRCS(:,:,:) )
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
END WHERE
+ !$mnh_end_expand_where()
ELSE
G3D(:,:,:) = PRCT(:,:,:)>0.0 .AND. PRCS(:,:,:)>0.0
+ !$mnh_expand_where(JI=1:JIU,JJ=1:JJU,JK=1:JKU)
WHERE ( G3D(:,:,:) )
ZW(:,:,:) = XC1RC * MAX ( PRCT(:,:,:) - XC2RC / PRHODREF(:,:,:), 0. )
ZW(:,:,:) = MIN ( ZW(:,:,:) , PRCS(:,:,:) )
@@ -447,6 +466,7 @@ ELSE
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
END WHERE
+ !$mnh_end_expand_where()
END IF
!$acc end kernels
!
@@ -467,6 +487,7 @@ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:,
!$acc kernels
PEVAP3D(:,:,:)=0.
G3D(:,:,:) = PRRT(:,:,:)>0.0 .AND. PRCT(:,:,:)==0.0
+!$mnh_expand_where(JI=1:JIU,JJ=1:JJU,JK=1:JKU)
WHERE ( G3D(:,:,:) )
!
!* 5.1 compute the Exner function
@@ -531,6 +552,7 @@ WHERE ( G3D(:,:,:) )
+ XCL * (PRCT(:,:,:) + PRRT(:,:,:)) ) )
PEVAP3D(:,:,:)=ZW(:,:,:)
END WHERE
+!$mnh_end_expand_where()
!$acc end kernels
!
!* 5.8 budget storage
@@ -565,6 +587,13 @@ END IF
!$acc end data
+#ifndef MNH_OPENACC
+deallocate (zt, zw, zw1, zw2, zw3, zexnt, zdzz, g3d )
+#else
+!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
+CALL MNH_MEM_RELEASE()
+#endif
+
!$acc end data
END SUBROUTINE SLOW_TERMS
--
GitLab