From faacd3d24b7db4d0f640423f356b4d7a7367fcd0 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 24 Feb 2017 13:42:56 +0100
Subject: [PATCH] Philippe 27/02/2017: OpenACC: work on rain_ice.f90 (1st
version with kernels everywhere for Hector testcase))
---
src/MNH/rain_ice.f90 | 280 ++++++++++++++++++++++++++-----------------
1 file changed, 170 insertions(+), 110 deletions(-)
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index 3987911a8..a9c645156 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -475,10 +475,10 @@ INTEGER :: JL ! and PACK intrinsics
!$acc & ZRVS,ZRCS,ZRRS,ZRIS,ZRSS,ZRGS,ZRHS,ZTHS, &
!$acc & ZRHODREF,ZRHODREFR,ZRHODREFI,ZRHODREFS,ZRHODREFG,ZRHODREFH, &
!$acc & ZRHODJ,ZZT,ZPRES,ZZW,ZLSFACT,ZLVFACT, &
-!$acc & ZUSW,ZSSI,ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH,ZRDRYG,ZRWETG, &
+!$acc & ZUSW,ZSSI,ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH, &
!$acc & ZAI,ZCJ,ZKA,ZDV,ZZW1,ZRTMIN) &
-!$acc & device_resident(ZCRIAUTI,ZEXNREF,ZSIGMA_RC,ZCF,ZCC,ZFSEDC1D,ZWLBDC, &
-!$acc & ZCONC,ZRAY1D,ZWLBDA,I1,I2,I3)
+!$acc & device_resident(ZCRIAUTI,ZEXNREF,ZRDRYG,ZRWETG,ZSIGMA_RC,ZCF,ZCC, &
+!$acc & ZFSEDC1D,ZWLBDC,ZCONC,ZRAY1D,ZWLBDA,I1,I2,I3)
!
#ifdef _OPENACC
PRINT *,'OPENACC: RAIN_ICE being implemented'
@@ -646,13 +646,6 @@ IF( IMICRO >= 0 ) THEN
ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
! Supersaturation over ice
!$acc end kernels
-!$acc update self(ZRHODREF,ZZT,ZPRES,ZLSFACT,ZLVFACT,ZSSI,ZRCT,ZRRT,ZRIT,ZRST,ZRGT,ZCIT,&
-!$acc & ZRCS,ZRRS,ZRIS,ZRSS,ZRGS,ZTHS)
-#ifdef _OPENACC
- IF (KRR == 7 ) THEN
-!$acc update self(ZRHT,ZRHS)
- END IF
-#endif
!
IF (LBU_ENABLE .OR. LLES_CALL .OR. LCHECK) THEN
ALLOCATE(ZRHODJ(IMICRO))
@@ -683,7 +676,6 @@ IF( IMICRO >= 0 ) THEN
#endif
END WHERE
!$acc end kernels
-!$acc update self(ZLBDAR)
!
IF( OWARM ) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
@@ -751,7 +743,6 @@ IF( IMICRO >= 0 ) THEN
ZW(:,:,:) = PCIT(:,:,:)
PCIT(:,:,:) = UNPACK( ZCIT(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
#else
-!$acc update device(ZRCS,ZRRS,ZRIS,ZRRS,ZRSS,ZRGS,ZTHS)
!$acc kernels
DO JL=1,IMICRO
PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL)
@@ -775,7 +766,6 @@ IF( IMICRO >= 0 ) THEN
!$acc update self(PRHS)
END IF
#endif
-print *,'PW: RAIN_ICE 12'
!
!
!
@@ -1069,15 +1059,6 @@ PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
!$acc end kernels
-!$acc update self(ZPRRS,ZPRSS,ZPRGS)
-#ifdef _OPENACC
-IF (OSEDIC) THEN
-!$acc update self(ZPRCS)
-END IF
-IF ( KRR == 7 ) THEN
-!$acc update self(ZPRHS)
-END IF
-#endif
!
! PRiS = Source of the previous time step + source created during the subtime
! step
@@ -1521,6 +1502,11 @@ IF ( KRR == 7 .AND. LBUDGET_RH) &
!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
!
IF (LDEPOSC) THEN
+#ifdef _OPENACC
+ PRINT *,'OPENACC: RAIN_ICE_SEDIMENTATION_SPLIT::LDEPOSC=.T. not yet tested'
+ CALL ABORT
+#endif
+!$acc kernels
GDEP(:,:) = .FALSE.
GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,2) >0
WHERE (GDEP)
@@ -1528,6 +1514,8 @@ IF (LDEPOSC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,2) * PRHODJ(:,:,2) /XRHOLW
PINDEP(:,:) = XVDEPOSC * PRCT(:,:,2) * PRHODJ(:,:,2) /XRHOLW
END WHERE
+!$acc end kernels
+!$acc update self(PRCS,PINPRC,PINDEP)
END IF
!
!* 2.5 budget storage
@@ -2173,7 +2161,6 @@ IF( INEGT >= 1 ) THEN
ZZW(:) = ZZW(:) - ZCIT(:)
ZZWMAX = MAXVAL(ZZW(:))
!$acc end kernels
-!$acc update self(ZUSW,ZSSI)
IF( ZZWMAX > 0.0 ) THEN
!
!* 3.1.2 update the r_i and r_v mixing ratios
@@ -2361,8 +2348,7 @@ IMPLICIT NONE
ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
END WHERE
!$acc end kernels
-!$acc update self(ZAI,ZCJ,ZKA,ZDV)
-!$acc update self(ZLBDAS,ZTHS,ZRVS,ZRSS)
+!$acc update self(ZTHS,ZRVS,ZRSS)
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'DEPS_BU_RTH')
@@ -2462,7 +2448,7 @@ IMPLICIT NONE
ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
END WHERE
!$acc end kernels
-!$acc update self(ZLBDAG,ZTHS,ZRVS,ZRGS)
+!$acc update self(ZTHS,ZRVS,ZRGS)
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'DEPG_BU_RTH')
@@ -2597,7 +2583,6 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
END WHERE
!$acc end kernels
!$acc update self(ZTHS,ZRVS,ZRRS)
-print *,'PW: RAIN_ICE_WARM 04'
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'REVA_BU_RTH')
@@ -2619,7 +2604,6 @@ print *,'PW: RAIN_ICE_WARM 04'
!$acc update self(PEVAP3D)
#endif
!
-print *,'PW: RAIN_ICE_WARM 05'
END SUBROUTINE RAIN_ICE_WARM
!
!-------------------------------------------------------------------------------
@@ -2819,19 +2803,17 @@ INTEGER :: JL ! and PACK intrinsics
ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) )
ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) )
#else
-!$acc kernels
+!$acc kernels copyin(XKER_RACCSS)
DO JL=1,IGACC
ZVEC1(JL) = ZLBDAS(I1(JL))
ZVEC2(JL) = ZLBDAR(I1(JL))
END DO
-!$acc end kernels
#endif
!
! 5.2.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
! tabulate the RACCSS-kernel
!
-!$acc kernels copyin(XKER_RACCSS) present(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3)
ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NACCLBDAS)-0.00001, &
#ifndef MNH_BITREP
XACCINTP1S * LOG( ZVEC1(:) ) + XACCINTP2S ) )
@@ -2861,11 +2843,9 @@ INTEGER :: JL ! and PACK intrinsics
- XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
-!$acc end kernels
#ifndef _OPENACC
ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
#else
-!$acc kernels
ZZW(:) = 0.0
DO JL=1,IGACC
ZZW(I1(JL)) = ZVEC3(JL)
@@ -2875,7 +2855,9 @@ INTEGER :: JL ! and PACK intrinsics
!
! 5.2.4 raindrop accretion on the small sized aggregates
!
-!$acc kernels present(GACC,ZLBDAS,ZRHODREF,ZZW,ZLSFACT,ZLVFACT,ZLBDAR,ZZW1,ZRRS,ZRSS,ZTHS)
+!$acc kernels present(GACC,ZLBDAS,ZRHODREF,ZZW,ZLSFACT,ZLVFACT,ZLBDAR, &
+!$acc & ZZW1,ZRRS,ZRSS,ZTHS,IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3) &
+!$acc & copyin(XKER_RACCS)
WHERE ( GACC(:) )
#ifndef MNH_BITREP
ZZW1(:,2) = & !! coef of RRACCS
@@ -2895,12 +2877,10 @@ INTEGER :: JL ! and PACK intrinsics
ZRSS(:) = ZRSS(:) + ZZW1(:,4)
ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS))
END WHERE
-!$acc end kernels
!
! 5.2.4b perform the bilinear interpolation of the normalized
! RACCS-kernel
!
-!$acc kernels copyin(XKER_RACCS) present(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3)
DO JJ = 1,IGACC
ZVEC3(JJ) = ( XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
@@ -2911,11 +2891,10 @@ INTEGER :: JL ! and PACK intrinsics
END DO
!$acc end kernels
#ifndef _OPENACC
-!$acc update self(GACC)
ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 )
#else
!$acc update self(I1)
-!$acc kernels present(I1,ZZW1,ZVEC3)
+!$acc kernels present(I1,ZZW1,ZVEC3,IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3) copyin(XKER_SACCRG)
ZZW1(1:I1(1)-1,2) = 0.0
ZZW1(I1(1),2) = ZZW1(I1(1),2)*ZVEC3(1)
DO JL=2,IGACC
@@ -2923,13 +2902,11 @@ INTEGER :: JL ! and PACK intrinsics
ZZW1(I1(JL),2) = ZZW1(I1(JL),2)*ZVEC3(JL)
END DO
ZZW1(I1(IGACC)+1:,2) = 0.0
-!$acc end kernels
#endif
!! RRACCS!
! 5.2.5 perform the bilinear interpolation of the normalized
! SACCRG-kernel
!
-!$acc kernels copyin(XKER_SACCRG) present(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3)
DO JJ = 1,IGACC
ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
@@ -2938,30 +2915,25 @@ INTEGER :: JL ! and PACK intrinsics
- XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* (ZVEC2(JJ) - 1.0)
END DO
-!$acc end kernels
-! #ifndef _OPENACC
-!$acc update self(GACC,ZVEC3)
+#ifndef _OPENACC
ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
-! #else
-! !acc kernels
-! ZZW(:) = 0.0
-! DO JL=1,IGACC
-! ZZW(I1(JL)) = ZVEC3(JL)
-! END DO
-! !acc end kernels
-! #endif
+#else
+ ZZW(:) = 0.0
+ DO JL=1,IGACC
+ ZZW(I1(JL)) = ZVEC3(JL)
+ END DO
+#endif
!
! 5.2.6 raindrop accretion-conversion of the large sized aggregates
! into graupeln
!
-!$acc kernels
- WHERE ( GACC(:) .AND. (ZRSS(:)>0.0) )
+ GWORK(:) = GACC(:) .AND. (ZRSS(:)>0.0)
+ WHERE ( GWORK(:) )
ZZW1(:,2) = MAX( MIN( ZRRS(:),ZZW1(:,2)-ZZW1(:,4) ),0.0 ) ! RRACCSG
END WHERE
!$acc end kernels
-!$acc update self(ZZW1,ZRRS,ZRSS,ZTHS)
-!acc kernels copyin(ZZW) present(GWORK,GACC,ZLBDAS,ZRHODREF,ZLSFACT,ZLVFACT,ZLBDAR,ZZW1,ZRRS,ZRSS,ZRGS,ZTHS) default(none)
- GWORK(:) = GACC(:) .AND. (ZRSS(:)>0.0) .AND. ZZW1(:,2)>0.0
+!$acc kernels present(GWORK,GACC,ZLBDAS,ZRHODREF,ZLSFACT,ZLVFACT,ZLBDAR,ZZW1,ZRRS,ZRSS,ZRGS,ZTHS,ZZW) default(none)
+ GWORK(:) = GWORK(:) .AND. ZZW1(:,2)>0.0
WHERE ( GWORK(:) )
#ifndef MNH_BITREP
ZZW1(:,3) = MIN( ZRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG
@@ -2982,7 +2954,8 @@ INTEGER :: JL ! and PACK intrinsics
ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) !
! f(L_f*(RRACCSG))
END WHERE
-!acc end kernels
+!$acc end kernels
+!$acc update self(ZRRS,ZRSS,ZRGS,ZTHS)
DEALLOCATE(IVEC2)
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC3)
@@ -3005,8 +2978,8 @@ INTEGER :: JL ! and PACK intrinsics
!
!* 5.3 Conversion-Melting of the aggregates
!
-!$acc update self(ZRVT)
-!acc kernels
+!$acc kernels default(none) present(ZZW,GWORK,ZRST,ZRSS,ZZT,ZRVT,ZPRES,ZKA,ZDV,ZLBDAS,ZCJ,ZZW1,ZRHODREF,ZRGS) &
+!$acc & copyin(XRTMIN,XEX0DEPS,XEX1DEPS)
ZZW(:) = 0.0
GWORK(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>0.0) .AND. (ZZT(:)>XTT)
WHERE( GWORK(:) )
@@ -3039,7 +3012,8 @@ INTEGER :: JL ! and PACK intrinsics
ZRSS(:) = ZRSS(:) - ZZW(:)
ZRGS(:) = ZRGS(:) + ZZW(:)
END WHERE
-!acc end kernels
+!$acc end kernels
+!$acc update self(ZRSS,ZRGS)
IF (LBUDGET_RS) CALL BUDGET ( &
UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
10,'CMEL_BU_RRS')
@@ -3059,14 +3033,20 @@ INTEGER :: JL ! and PACK intrinsics
!
IMPLICIT NONE
!
+INTEGER :: JL
+INTEGER,DIMENSION(:),ALLOCATABLE :: I1
+!$acc declare create(I1)
+!
!-------------------------------------------------------------------------------
!
!* 6.1 rain contact freezing
!
-!acc kernels
+!$acc kernels copyin(XEXICFRR,XEXRCFRI,XRTMIN) default(none) &
+!$acc & present(ZZW1,GWORK,ZRIT,ZRRT,ZRIS,ZRRS,ZRGS,ZTHS,ZLBDAR,ZRHODREF,ZCIT,ZLSFACT,ZLVFACT)
ZZW1(:,3:4) = 0.0
- WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. &
- (ZRIS(:)>0.0) .AND. (ZRRS(:)>0.0) )
+ GWORK(:) = (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. &
+ (ZRIS(:)>0.0) .AND. (ZRRS(:)>0.0)
+ WHERE( GWORK(:) )
#ifndef MNH_BITREP
ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) & ! RICFRRG
* ZLBDAR(:)**XEXICFRR &
@@ -3087,7 +3067,8 @@ IMPLICIT NONE
ZRGS(:) = ZRGS(:) + ZZW1(:,3)+ZZW1(:,4)
ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*RRCFRIG)
END WHERE
-!acc end kernels
+!$acc end kernels
+!$acc update self(ZRIS,ZRRS,ZRGS,ZTHS)
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'CFRZ_BU_RTH')
@@ -3103,8 +3084,11 @@ IMPLICIT NONE
!
!* 6.2 compute the Dry growth case
!
+!$acc kernels copyin(XRTMIN) default(none) &
+!$acc & present(ZZW1,GWORK,ZRGT,ZRCT,ZRCS,ZRIT,ZRIS,ZLBDAG,ZRHODREF,ZZW)
ZZW1(:,:) = 0.0
- WHERE( (ZRGT(:)>XRTMIN(6)) .AND. ((ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>0.0)) )
+ GWORK(:) = (ZRGT(:)>XRTMIN(6)) .AND. ((ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>0.0))
+ WHERE( GWORK(:) )
#ifndef MNH_BITREP
ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
#else
@@ -3112,7 +3096,8 @@ IMPLICIT NONE
#endif
ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
END WHERE
- WHERE( (ZRGT(:)>XRTMIN(6)) .AND. ((ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>0.0)) )
+ GWORK(:) = (ZRGT(:)>XRTMIN(6)) .AND. ((ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>0.0))
+ WHERE( GWORK(:) )
#ifndef MNH_BITREP
ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
@@ -3123,12 +3108,20 @@ IMPLICIT NONE
* ZRIT(:) * ZZW(:) ) ! RIDRYG
#endif
END WHERE
+!$acc end kernels
!
!* 6.2.1 accretion of aggregates on the graupeln
!
ALLOCATE(GDRY(IMICRO))
+ ALLOCATE(I1(IMICRO)) !I1 is bigger than necessary but it easier to do it now (instead of computing IGDRY before allocating I1)
+!$acc kernels
GDRY(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRSS(:)>0.0)
+!$acc end kernels
+#ifndef _OPENACC
IGDRY = COUNT( GDRY(:) )
+#else
+ CALL COUNTJV1D_DEVICE( GDRY(:),I1,IGDRY)
+#endif
!
IF( IGDRY>0 ) THEN
!
@@ -3142,8 +3135,16 @@ IMPLICIT NONE
!
!* 6.2.3 select the (ZLBDAG,ZLBDAS) couplet
!
+#ifndef _OPENACC
ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) )
+#else
+!$acc kernels
+ DO JL=1,IGDRY
+ ZVEC1(JL) = ZLBDAG(I1(JL))
+ ZVEC2(JL) = ZLBDAS(I1(JL))
+ END DO
+#endif
!
!* 6.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
@@ -3166,10 +3167,13 @@ IMPLICIT NONE
#endif
IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
+!$acc end kernels
!
!* 6.2.5 perform the bilinear interpolation of the normalized
! SDRYG-kernel
!
+!$acc kernels copyin(XKER_SDRYG,XCOLEXSG,XCXG) default(none) &
+!$acc & present(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3,GDRY,ZZW1,ZRSS,ZZW,ZZT,ZLBDAS,ZLBDAG,ZRHODREF)
DO JJ = 1,IGDRY
ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
@@ -3178,7 +3182,14 @@ IMPLICIT NONE
- XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
+#ifndef _OPENACC
ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+#else
+ ZZW(:) = 0.0
+ DO JL=1,IGDRY
+ ZZW(I1(JL)) = ZVEC3(JL)
+ END DO
+#endif
!
WHERE( GDRY(:) )
#ifndef MNH_BITREP
@@ -3199,6 +3210,7 @@ IMPLICIT NONE
XLBSDRYG3/( ZLBDAS(:)**2) ) )
#endif
END WHERE
+!$acc end kernels
DEALLOCATE(IVEC2)
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC3)
@@ -3208,8 +3220,14 @@ IMPLICIT NONE
!
!* 6.2.6 accretion of raindrops on the graupeln
!
+!$acc kernels
GDRY(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRRS(:)>0.0)
+!$acc end kernels
+#ifndef _OPENACC
IGDRY = COUNT( GDRY(:) )
+#else
+ CALL COUNTJV1D_DEVICE( GDRY(:),I1,IGDRY)
+#endif
!
IF( IGDRY>0 ) THEN
!
@@ -3223,8 +3241,16 @@ IMPLICIT NONE
!
!* 6.2.8 select the (ZLBDAG,ZLBDAR) couplet
!
+#ifndef _OPENACC
ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
+#else
+!$acc kernels
+ DO JL=1,IGDRY
+ ZVEC1(JL) = ZLBDAG(I1(JL))
+ ZVEC2(JL) = ZLBDAR(I1(JL))
+ END DO
+#endif
!
!* 6.2.9 find the next lower indice for the ZLBDAG and for the ZLBDAR
! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
@@ -3247,10 +3273,13 @@ IMPLICIT NONE
#endif
IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
+!$acc end kernels
!
!* 6.2.10 perform the bilinear interpolation of the normalized
! RDRYG-kernel
!
+!$acc kernels copyin(XKER_RDRYG,XCXG) default(none) &
+!$acc & present(IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3,GDRY,ZZW1,ZRRS,ZZW,ZLBDAR,ZLBDAG,ZRHODREF)
DO JJ = 1,IGDRY
ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
@@ -3259,7 +3288,14 @@ IMPLICIT NONE
- XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
+#ifndef _OPENACC
ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+#else
+ ZZW(:) = 0.0
+ DO JL=1,IGDRY
+ ZZW(I1(JL)) = ZVEC3(JL)
+ END DO
+#endif
!
WHERE( GDRY(:) )
#ifndef MNH_BITREP
@@ -3278,6 +3314,7 @@ IMPLICIT NONE
XLBRDRYG3/( ZLBDAR(:)**2) ) )
#endif
END WHERE
+!$acc end kernels
DEALLOCATE(IVEC2)
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC3)
@@ -3285,12 +3322,15 @@ IMPLICIT NONE
DEALLOCATE(ZVEC1)
END IF
!
+!$acc kernels
ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
-!$acc update device(ZRDRYG)
+!$acc end kernels
DEALLOCATE(GDRY)
!
!* 6.3 compute the Wet growth case
!
+!$acc kernels default(none) copyin(XRTMIN,XEX0DEPG,XEX1DEPG) &
+!$acc & present(ZZW,ZRWETG,ZRGT,ZZW1,ZRIS,ZRSS,ZRVT,ZZT,ZPRES,ZKA,ZDV,ZLBDAG,ZCJ)
ZZW(:) = 0.0
ZRWETG(:) = 0.0
WHERE( ZRGT(:)>XRTMIN(6) )
@@ -3329,55 +3369,58 @@ IMPLICIT NONE
( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
#endif
END WHERE
-!$acc update device(ZRWETG)
+!$acc end kernels
!
!* 6.4 Select Wet or Dry case
!
- ZZW(:) = 0.0
+!$acc kernels
+ ZZW(:) = 0.0
IF ( KRR == 7 ) THEN
- WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
- .AND. & ! Wet
- ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 ) ! case
- ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
+ GWORK(:) = ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT .AND. & ! Wet
+ ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 ! case
+ WHERE( GWORK(:) )
+ ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
!
! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
!
- ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),ZRRS(:)+ZZW1(:,1) ) )
- ZUSW(:) = ZZW1(:,7) / ZZW(:)
- ZZW1(:,5) = ZZW1(:,5)*ZUSW(:)
- ZZW1(:,6) = ZZW1(:,6)*ZUSW(:)
- ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
+ ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),ZRRS(:)+ZZW1(:,1) ) )
+ ZUSW(:) = ZZW1(:,7) / ZZW(:)
+ ZZW1(:,5) = ZZW1(:,5)*ZUSW(:)
+ ZZW1(:,6) = ZZW1(:,6)*ZUSW(:)
+ ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
!
- ZRCS(:) = ZRCS(:) - ZZW1(:,1)
- ZRIS(:) = ZRIS(:) - ZZW1(:,5)
- ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,5)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
!
! assume a linear percent of conversion of graupel into hail
!
- ZRGS(:) = ZRGS(:) + ZRWETG(:) ! Wet growth
- ZZW(:) = ZRGS(:)*ZRDRYG(:)/(ZRWETG(:)+ZRDRYG(:)) ! and
- ZRGS(:) = ZRGS(:) - ZZW(:) ! partial conversion
- ZRHS(:) = ZRHS(:) + ZZW(:) ! of the graupel into hail
+ ZRGS(:) = ZRGS(:) + ZRWETG(:) ! Wet growth
+ ZZW(:) = ZRGS(:)*ZRDRYG(:)/(ZRWETG(:)+ZRDRYG(:)) ! and
+ ZRGS(:) = ZRGS(:) - ZZW(:) ! partial conversion
+ ZRHS(:) = ZRHS(:) + ZZW(:) ! of the graupel into hail
!
- ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
- ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:))
+ ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
+ ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:))
! f(L_f*(RCWETG+RRWETG))
- END WHERE
- ELSE IF( KRR == 6 ) THEN
- WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
- .AND. & ! Wet
- ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 ) ! case
- ZZW(:) = ZRWETG(:)
- ZRCS(:) = ZRCS(:) - ZZW1(:,1)
- ZRIS(:) = ZRIS(:) - ZZW1(:,5)
- ZRSS(:) = ZRSS(:) - ZZW1(:,6)
- ZRGS(:) = ZRGS(:) + ZZW(:)
+ END WHERE
+ ELSE IF( KRR == 6 ) THEN
+ GWORK(:) = ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT .AND. & ! Wet
+ ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 ! case
+ WHERE( GWORK(:) )
+ ZZW(:) = ZRWETG(:)
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,5)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+ ZRGS(:) = ZRGS(:) + ZZW(:)
!
- ZRRS(:) = ZRRS(:) - ZZW(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1)
- ZTHS(:) = ZTHS(:) + (ZZW(:)-ZZW1(:,5)-ZZW1(:,6))*(ZLSFACT(:)-ZLVFACT(:))
- ! f(L_f*(RCWETG+RRWETG))
- END WHERE
- END IF
+ ZRRS(:) = ZRRS(:) - ZZW(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1)
+ ZTHS(:) = ZTHS(:) + (ZZW(:)-ZZW1(:,5)-ZZW1(:,6))*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+ END WHERE
+ END IF
+!$acc end kernels
+!$acc update self(ZRCS,ZRIS,ZRSS,ZRGS,ZRRS,ZTHS)
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'WETG_BU_RTH')
@@ -3403,9 +3446,10 @@ IMPLICIT NONE
END IF
!
- WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
- .AND. &
- ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! Dry
+!$acc kernels
+ GWORK(:) = ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT .AND. &
+ ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ! Dry
+ WHERE( GWORK(:) )
ZRCS(:) = ZRCS(:) - ZZW1(:,1)
ZRIS(:) = ZRIS(:) - ZZW1(:,2)
ZRSS(:) = ZRSS(:) - ZZW1(:,3)
@@ -3414,6 +3458,8 @@ IMPLICIT NONE
ZTHS(:) = ZTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(ZLSFACT(:)-ZLVFACT(:)) !
! f(L_f*(RCDRYG+RRDRYG))
END WHERE
+!$acc end kernels
+!$acc update self(ZRCS,ZRIS,ZRSS,ZRRS,ZRGS)
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'DRYG_BU_RTH')
@@ -3440,8 +3486,11 @@ IMPLICIT NONE
!
!* 6.5 Melting of the graupeln
!
+!$acc kernels default(none) copyin(XRTMIN,XEX0DEPG,XEX1DEPG) &
+!$acc & present(ZZW,ZRRS,ZRGT,ZTHS,ZRGS,ZZW1,ZRVT,ZZT,ZPRES,ZKA,ZDV,ZLBDAG,ZCJ,ZLSFACT,ZLVFACT)
ZZW(:) = 0.0
- WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>0.0) .AND. (ZZT(:)>XTT) )
+ GWORK(:) = (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>0.0) .AND. (ZZT(:)>XTT)
+ WHERE( GWORK(:) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
@@ -3468,6 +3517,8 @@ IMPLICIT NONE
ZRGS(:) = ZRGS(:) - ZZW(:)
ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RGMLTR))
END WHERE
+!$acc end kernels
+!$acc update self(ZRRS,ZRGS,ZTHS)
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'GMLT_BU_RTH')
@@ -3477,6 +3528,8 @@ IMPLICIT NONE
IF (LBUDGET_RG) CALL BUDGET ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'GMLT_BU_RRG')
+!
+ DEALLOCATE(I1)
!
END SUBROUTINE RAIN_ICE_FAST_RG
!
@@ -3811,15 +3864,18 @@ IMPLICIT NONE
!
!* 7.1 cloud ice melting
!
+!$acc kernels
ZZW(:) = 0.0
- WHERE( (ZRIS(:)>0.0) .AND. (ZZT(:)>XTT) )
+ GWORK(:) = (ZRIS(:)>0.0) .AND. (ZZT(:)>XTT)
+ WHERE( GWORK(:) )
ZZW(:) = ZRIS(:)
ZRCS(:) = ZRCS(:) + ZRIS(:)
ZTHS(:) = ZTHS(:) - ZRIS(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RIMLTC))
ZRIS(:) = 0.0
ZCIT(:) = 0.0
END WHERE
-!$acc update device(ZCIT)
+!$acc end kernels
+!$acc update self(ZRCS,ZTHS,ZRIS)
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'IMLT_BU_RTH')
@@ -3832,9 +3888,11 @@ IMPLICIT NONE
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
+!$acc kernels
ZZW(:) = 0.0
- WHERE( (ZRCS(:)>0.0) .AND. (ZSSI(:)>0.0) .AND. &
- (ZRIT(:)>XRTMIN(4)) .AND. (ZCIT(:)>0.0) )
+ GWORK(:) = (ZRCS(:)>0.0) .AND. (ZSSI(:)>0.0) .AND. &
+ (ZRIT(:)>XRTMIN(4)) .AND. (ZCIT(:)>0.0)
+ WHERE( GWORK(:) )
#ifndef MNH_BITREP
ZZW(:) = MIN(1.E8,XLBI*( ZRHODREF(:)*ZRIT(:)/ZCIT(:) )**XLBEXI) ! Lbda_i
ZZW(:) = MIN( ZRCS(:),( ZSSI(:) / (ZRHODREF(:)*ZAI(:)) ) * ZCIT(:) * &
@@ -3848,6 +3906,8 @@ IMPLICIT NONE
ZRIS(:) = ZRIS(:) + ZZW(:)
ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCBERI))
END WHERE
+!$acc end kernels
+!$acc update self(ZRCS,ZRIS,ZTHS)
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
4,'BERFI_BU_RTH')
--
GitLab