Skip to content
Snippets Groups Projects
Commit b030d7ae authored by ESCOBAR MUNOZ Juan's avatar ESCOBAR MUNOZ Juan
Browse files

Juan 07/03/2023:slow_terms.f90, Bypass CRAY CCE/15.0.1 compiler bug => remove... 

Juan 07/03/2023:slow_terms.f90, Bypass CRAY CCE/15.0.1 compiler bug => remove size(...) in kernels + use MNH_MEM_GET
parent a5fac966
No related branches found
No related tags found
1 merge request!4Jean Wurtz 30/04/2025 : Bugfixes mainly for TEB and for simple precision
Hide whitespace changes
Inline Side-by-side
Showing
with 63 additions and 34 deletions
src/MNH/slow_terms.f90
+ 63
− 34
View file @ b030d7ae
......@@ -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
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme