diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90
index aa453f1124a1c739a6ff65aea31716d1c1a1758f..662914c2d9eda76efdebdeba2413acaad0ba661d 100644
--- a/src/MNH/ice4_sedimentation_split.f90
+++ b/src/MNH/ice4_sedimentation_split.f90
@@ -492,18 +492,18 @@ ZREMAINT(:,:) = PTSTEP
DO WHILE (ANY(ZREMAINT>0.))
!$acc kernels
ISEDIM = 0
-!$acc loop independent private(IDX,JI,JJ,JK)
+!acc loop independent private(IDX,JI,JJ,JK)
DO JK = KKTB,KKTE
-!$acc loop independent collapse(2)
+!acc loop independent collapse(2)
DO JJ = KJB,KJE
DO JI = KIB,KIE
IF( (PRXT (JI,JJ,JK)>XRTMIN(KSPE) .OR. &
PPRXS(JI,JJ,JK)>ZRSMIN(KSPE)) .AND. &
ZREMAINT(JI,JJ)>0. ) THEN
-!$acc atomic capture
+!acc atomic capture
ISEDIM = ISEDIM + 1
IDX = ISEDIM
-!$acc end atomic
+!acc end atomic
I1(IDX) = JI
I2(IDX) = JJ
I3(IDX) = JK
@@ -581,26 +581,35 @@ if (JK==-9999) print *,'PW: ISEDIM=',ISEDIM
ENDDO
!$acc end kernels
ELSE
-!$acc kernels
+!acc kernels
! ******* for other species
SELECT CASE(KSPE)
CASE(3)
+!$acc kernels
ZFSED=XFSEDR
ZEXSED=XEXSEDR
+!$acc end kernels
CASE(5)
+!$acc kernels
ZFSED=XFSEDS
ZEXSED=XEXSEDS
+!$acc end kernels
CASE(6)
+!$acc kernels
ZFSED=XFSEDG
ZEXSED=XEXSEDG
+!$acc end kernels
CASE(7)
+!$acc kernels
ZFSED=XFSEDH
ZEXSED=XEXSEDH
+!$acc end kernels
CASE DEFAULT
write( yspe, '( I10 )' ) kspe
call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
END SELECT
!
+!$acc kernels
ZWSED(:,:,:) = 0.
!$acc loop independent private(JI,JJ,JK,JL)
DO JL=1, ISEDIM
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index 42a602f88f894aceeae0456b575684179687621b..dcd7c3206e7c9cb1b84ec22cb30ae4caa3bb449b 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -2,20 +2,19 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######spl
+! ####################
MODULE MODI_RAIN_ICE
! ####################
!
INTERFACE
- SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
- KSPLITR, PTSTEP, KRR, &
- PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
- PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
+ SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
+ KSPLITR, PTSTEP, KRR, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
!
!
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
@@ -26,16 +25,16 @@ LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KKA ! Near ground array index
+INTEGER, INTENT(IN) :: KKU ! Uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! Vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integration for rain sedimendation
+ ! integration for rain sedimendation
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thickness (m)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -62,34 +61,34 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! Upper-air precipitation fluxes
!
END SUBROUTINE RAIN_ICE
END INTERFACE
END MODULE MODI_RAIN_ICE
-! ######spl
- SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
- KSPLITR, PTSTEP, KRR, &
- PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
- PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
-! ######################################################################
+! ##############################################################################
+ SUBROUTINE RAIN_ICE ( OSEDIC,HSEDIM, HSUBG_AUCV, OWARM, KKA, KKU, KKL, &
+ KSPLITR, PTSTEP, KRR, &
+ PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
+! ##############################################################################
!
!!**** * - compute the explicit microphysical sources
!!
@@ -252,7 +251,7 @@ use MODD_BUDGET, only: LBU_ENABLE, LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, L
use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
XALPI, XBETAI, XGAMI, XMD, XMV, XTT
use MODD_LES, only: LLES_CALL
-use MODD_PARAMETERS, only: JPVEXT
+use MODD_PARAMETERS, only: JPVEXT, XNEGUNDEF
use MODD_PARAM_ICE, only: CSUBG_PR_PDF, LDEPOSC
use MODD_RAIN_ICE_DESCR, only: XLBEXR, XLBR, XRTMIN
use MODD_RAIN_ICE_PARAM, only: XCRIAUTC
@@ -268,8 +267,15 @@ use MODE_RAIN_ICE_SEDIMENTATION_SPLIT, only: RAIN_ICE_SEDIMENTATION_SPLIT
use MODE_RAIN_ICE_SEDIMENTATION_STAT, only: RAIN_ICE_SEDIMENTATION_STAT
use MODE_RAIN_ICE_SLOW, only: RAIN_ICE_SLOW
use MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
+#ifndef _OPENACC
use mode_tools, only: Countjv
+#else
+use mode_tools, only: Countjv_device
+#endif
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
use MODI_BUDGET
USE MODI_ICE4_RAINFR_VERT
@@ -287,16 +293,16 @@ LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+INTEGER, INTENT(IN) :: KKA ! Near ground array index
+INTEGER, INTENT(IN) :: KKU ! Uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL ! Vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integration for rain sedimendation
+ ! integration for rain sedimendation
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thickness (m)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -323,20 +329,36 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! Upper-air precipitation fluxes
+!
+! IN variables
+!
+!$acc declare present(PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+!$acc & PCLDFR, PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+!$acc & PSIGS, PSEA, PTOWN, PRHT) &
+!
+! INOUT variables
+!
+!$acc & present(PCIT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+!$acc & PINPRC, PINDEP, PINPRR, PEVAP3D, &
+!$acc & PINPRS, PINPRG, PRHS, PINPRH) &
+!
+! OUT variables
+!
+!$acc & present(PINPRR3D, PRAINFR, PFPR)
!
!* 0.2 Declarations of local variables :
!
@@ -350,9 +372,9 @@ INTEGER :: IKB,IKTB,IKT !
INTEGER :: IKE,IKTE !
!
INTEGER :: IMICRO
-INTEGER, DIMENSION(SIZE(PEXNREF)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
-LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE &
:: GMICRO ! Test where to compute all processes
REAL :: ZINVTSTEP
REAL :: ZCOEFFRCM
@@ -413,11 +435,70 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
ZHLC_LRCLOCAL ! HLCLOUDS : LWC that is Low LWC local in LCF
! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
! = ZHLC_HRC/HCF+ ZHLC_LRC/LCF
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
- :: ZW ! work array
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
- :: ZT ! Temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW ! work array
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT ! Temperature
+LOGICAL :: GPRESENT_PFPR,GPRESENT_PSEA
+!
+#if 0
+!acc declare create(GMICRO,GWET,GHAIL,GDEP, &
+!acc & IVEC1,IVEC2,ZVEC1,ZVEC2,ZVEC3,ZW, &
+!acc & ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS,ZRAINFR, &
+!acc & ZWSED,ZWSEDW1,ZWSEDW2,ZCONC_TMP,ZT,ZRAY,ZLBC,ZFSEDC, &
+!acc & ZRVT,ZRCT,ZRRT,ZRIT,ZRST,ZRGT,ZRHT,ZCIT, &
+!acc & ZRVS,ZRCS,ZRRS,ZRIS,ZRSS,ZRGS,ZRHS,ZTHS, &
+!acc & ZRHODREF, &
+!acc & ZRHODJ,ZZT,ZPRES,ZZW,ZZW2,ZZW3,ZZW4,ZLSFACT,ZLVFACT, &
+!acc & ZUSW,ZSSI,ZLBDAS,ZLBDAG,ZLBDAH, &
+!acc & ZAI,ZCJ,ZKA,ZDV,ZZW1,ZRTMIN) &
+!acc & device_resident(GSEDIMR,GSEDIMC,GSEDIMI,GSEDIMS,GSEDIMG,GSEDIMH, &
+!acc & GNEGT,GRIM,GACC,GDRY,GWORK, &
+!acc & ZEXNREF,ZLBDAR,ZRDRYG,ZRWETG,ZSIGMA_RC,ZCF, &
+!acc & I1,I2,I3 )
+
+! !$acc declare copyin(XALPHA1,XCEXVT,XEXCSEDI,XEX0DEPG,XEX1DEPG,XEX0DEPS,XEX1DEPS, &
+! !$acc & XEX0EVAR,XEX1EVAR, &
+! !$acc & XEXCACCR,XEXIAGGS,XEXSEDG,XEXSEDH,XEXSEDR,XEXSEDS, &
+! !$acc & XFSEDC,XFSEDG,XLBC,XLBEXC,XLBEXG,XLBEXI,XLBEXR,XLBEXS,XRTMIN, &
+! !$acc & XKER_RACCS,XKER_RACCSS,XKER_SACCRG,XCXS, &
+! !$acc & XRIMINTP1,XEXCRIMSS,XGAMINC_RIM1,XGAMINC_RIM2,XEXCRIMSG,XEXSRIMCG, &
+! !$acc & XEXICFRR,XEXRCFRI,XKER_SDRYG,XCOLEXSG,XCXG,XKER_RDRYG, &
+! !$acc & XALPHAC,XALPHAC2,XNUC,XNUC2 )
+
+! !$acc declare create(ZHLC_HCF3D,ZHLC_LCF3D,ZHLC_HRC3D,ZHLC_LRC3D, &
+!$acc declare create( ZRHODREF, &
+!$acc & ZRVT,ZRCS,ZRCT,ZRGS,ZRGT,ZRHS,ZRHT,ZRRS,ZRRT,ZRSS,ZRST,ZRVS, &
+!$acc & ZCIT,ZRIS,ZRIT,ZTHS,ZTHT,ZTHLT, &
+!$acc & ZRHODJ,ZZT,ZPRES,ZZW,ZLSFACT,ZLVFACT,ZUSW,ZSSI,ZLBDAR_RF,ZLBDAG,ZLBDAH, &
+!$acc & ZAI,ZCJ,ZKA,ZDV,ZCF,ZRF,ZHLC_HCF,ZHLC_HRC,ZHLC_LCF,ZHLC_LRC,ZZW1, &
+!$acc & GPRESENT_PFPR,GPRESENT_PSEA )
+
+!$acc data create(GMICRO, &
+!$acc & ZW, &
+!$acc & ZT, &
+!$acc & I1,I2,I3 )
+#else
+#if 1
+!Disabled if PGI 19.5 bug (crash of the compiler)
+!$acc declare copyin(XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
+!$acc & XALPI, XBETAI, XGAMI, XMD, XMV, XTT,&
+! !$acc & LLES_CALL,&
+!$acc & JPVEXT,&
+! !$acc & CSUBG_PR_PDF, LDEPOSC,&
+!$acc & XLBEXR, XLBR, XRTMIN,&
+!$acc & XCRIAUTC)
+#endif
+
+!$acc declare create(I1, I2, I3, GMICRO, &
+!$acc & ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
+!$acc & ZCIT, ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, ZTHT, ZTHLT, &
+!$acc & ZRHODREF, ZRHODJ, ZZT, ZPRES, ZEXNREF, ZZW, ZLSFACT, ZLVFACT, ZUSW, ZSSI, &
+!$acc & ZLBDAR, ZLBDAR_RF, ZLBDAS, ZLBDAG, ZLBDAH, ZRDRYG, ZRWETG, &
+!$acc & ZAI, ZCJ, ZKA, ZDV, ZSIGMA_RC, ZCF, ZRF, &
+!$acc & ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, ZHLC_RCMAX, ZRCRAUTC, &
+!$acc & ZHLC_HRCLOCAL, ZHLC_LRCLOCAL, ZZW1, ZW, ZT, &
+!$acc & GPRESENT_PFPR,GPRESENT_PSEA )
+#endif
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
@@ -462,6 +543,12 @@ IF ( KRR == 7 ) THEN
call Print_msg( NVERB_WARNING, 'GEN', 'RAIN_ICE', 'OPENACC: KRR=7 not yet tested' )
END IF
#endif
+
+ALLOCATE( I1(SIZE(PEXNREF)), I2(SIZE(PEXNREF)), I3(SIZE(PEXNREF)) )
+ALLOCATE( GMICRO(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
+ALLOCATE( ZW (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
+ALLOCATE( ZT (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
+
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE THE LOOP BOUNDS
@@ -479,6 +566,19 @@ IKTE=IKT-JPVEXT
!
ZINVTSTEP=1./PTSTEP
!
+IF (PRESENT(PFPR)) THEN
+ GPRESENT_PFPR = .TRUE.
+ELSE
+ GPRESENT_PFPR = .FALSE.
+END IF
+!
+IF (PRESENT(PSEA)) THEN
+ GPRESENT_PSEA = .TRUE.
+ELSE
+ GPRESENT_PSEA = .FALSE.
+END IF
+!$acc update device(GPRESENT_PFPR,GPRESENT_PSEA)
+!
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
! --------------------------------------
@@ -491,6 +591,7 @@ CALL RAIN_ICE_NUCLEATION(IIB, IIE, IJB, IJE, IKTB, IKTE,KRR,PTSTEP,&
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
+!$acc kernels
GMICRO(:,:,:) = .FALSE.
IF ( KRR == 7 ) THEN
@@ -509,8 +610,14 @@ GMICRO(:,:,:) = .FALSE.
PRST(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(5) .OR. &
PRGT(IIB:IIE,IJB:IJE,IKTB:IKTE)>XRTMIN(6)
END IF
+!$acc end kernels
+#ifndef _OPENACC
IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+#else
+CALL COUNTJV_DEVICE(GMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
+#endif
+
IF( IMICRO >= 0 ) THEN
ALLOCATE(ZRVT(IMICRO))
ALLOCATE(ZRCT(IMICRO))
@@ -553,50 +660,12 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZRCRAUTC(IMICRO))
ALLOCATE(ZHLC_HRCLOCAL(IMICRO))
ALLOCATE(ZHLC_LRCLOCAL(IMICRO))
-
- DO JL=1,IMICRO
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
- IF ( KRR == 7 ) ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
- IF ( HSUBG_AUCV == 'PDF ' .AND. CSUBG_PR_PDF == 'SIGM' ) THEN
- ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL)) * 2.
-! ZSIGMA_RC(JL) = MAX(PSIGS(I1(JL),I2(JL),I3(JL)) * 2., 1.E-12)
- END IF
- ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
- ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
- ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
- ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
- ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
- ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
- IF ( KRR == 7 ) ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
- ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
!
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
- ZTHLT(JL) = ZTHT(JL) - XLVTT * ZTHT(JL) / XCPD / ZZT(JL) * ZRCT(JL)
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
- ENDDO
ALLOCATE(ZZW(IMICRO))
ALLOCATE(ZLSFACT(IMICRO))
ALLOCATE(ZLVFACT(IMICRO))
- ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
- +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
- ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
ALLOCATE(ZUSW(IMICRO))
ALLOCATE(ZSSI(IMICRO))
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
- ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
- ! Supersaturation over ice
-!
ALLOCATE(ZLBDAR(IMICRO))
ALLOCATE(ZLBDAR_RF(IMICRO))
ALLOCATE(ZLBDAS(IMICRO))
@@ -612,7 +681,6 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZCJ(IMICRO))
ALLOCATE(ZKA(IMICRO))
ALLOCATE(ZDV(IMICRO))
-!
IF ( KRR == 7 ) THEN
ALLOCATE(ZZW1(IMICRO,7))
ELSE IF( KRR == 6 ) THEN
@@ -621,40 +689,115 @@ IF( IMICRO >= 0 ) THEN
!
IF (LBU_ENABLE .OR. LLES_CALL) THEN
ALLOCATE(ZRHODJ(IMICRO))
- DO JL=1,IMICRO
- ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
- END DO
ELSE
ALLOCATE(ZRHODJ(0))
END IF
!
+!$acc kernels
+!$acc loop independent
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ !
+ ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
+ !
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
+ ZTHLT(JL) = ZTHT(JL) - XLVTT * ZTHT(JL) / XCPD / ZZT(JL) * ZRCT(JL)
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ !
+ IF (KRR == 7 ) THEN
+!$acc loop independent
+ DO JL=1,IMICRO
+ ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
+ ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ENDIF
+!
+ IF ( HSUBG_AUCV == 'PDF ' .AND. CSUBG_PR_PDF == 'SIGM' ) THEN
+!$acc loop independent
+ DO JL=1,IMICRO
+ ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL)) * 2.
+! ZSIGMA_RC(JL) = MAX(PSIGS(I1(JL),I2(JL),I3(JL)) * 2., 1.E-12)
+ END DO
+ END IF
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+#ifndef MNH_BITREP
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+#else
+ ZZW(:) = BR_EXP( XALPI - XBETAI/ZZT(:) - XGAMI*BR_LOG(ZZT(:) ) )
+#endif
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+ !
+ IF (LBU_ENABLE .OR. LLES_CALL) THEN
+!$acc loop independent
+ DO JL=1,IMICRO
+ ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
+ END DO
+ END IF
+!
!Cloud water split between high and low content part is done here
!according to autoconversion option
ZRCRAUTC(:) = XCRIAUTC/ZRHODREF(:) ! Autoconversion rc threshold
+!$acc end kernels
+#ifdef _OPENACC
+ IF (LBU_ENABLE .OR. LLES_CALL) THEN
+!$acc update self(GMICRO, ZRHODJ) !used only in BUDGET
+ ENDIF
+#endif
IF (HSUBG_AUCV == 'NONE') THEN
+!$acc kernels
!Cloud water is entirely in low or high part
- WHERE (ZRCT(:) > ZRCRAUTC(:))
- ZHLC_HCF(:) = 1.
- ZHLC_LCF(:) = 0.0
- ZHLC_HRC(:) = ZRCT(:)
- ZHLC_LRC(:) = 0.0
- ZRF(:) = 1.
- ELSEWHERE (ZRCT(:) > XRTMIN(2))
- ZHLC_HCF(:) = 0.0
- ZHLC_LCF(:) = 1.
- ZHLC_HRC(:) = 0.0
- ZHLC_LRC(:) = ZRCT(:)
- ZRF(:) = 0.
- ELSEWHERE
- ZHLC_HCF(:) = 0.0
- ZHLC_LCF(:) = 0.0
- ZHLC_HRC(:) = 0.0
- ZHLC_LRC(:) = 0.0
- ZRF(:) = 0.
- END WHERE
+!$acc loop independent private(JL)
+ DO JL=1,IMICRO
+ IF (ZRCT(JL) > ZRCRAUTC(JL)) THEN
+ ZHLC_HCF(JL) = 1.
+ ZHLC_LCF(JL) = 0.0
+ ZHLC_HRC(JL) = ZRCT(JL)
+ ZHLC_LRC(JL) = 0.0
+ ZRF(JL) = 1.
+ ELSE IF (ZRCT(JL) > XRTMIN(2)) THEN
+ ZHLC_HCF(JL) = 0.0
+ ZHLC_LCF(JL) = 1.
+ ZHLC_HRC(JL) = 0.0
+ ZHLC_LRC(JL) = ZRCT(JL)
+ ZRF(JL) = 0.
+ ELSE
+ ZHLC_HCF(JL) = 0.0
+ ZHLC_LCF(JL) = 0.0
+ ZHLC_HRC(JL) = 0.0
+ ZHLC_LRC(JL) = 0.0
+ ZRF(JL) = 0.
+ END IF
+ END DO
+!$acc end kernels
ELSEIF (HSUBG_AUCV == 'CLFR') THEN
+#ifdef _OPENACC
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','OPENACC: HSUBG_AUCV="CLFR" not yet implemented')
+#endif
!Cloud water is only in the cloudy part and entirely in low or high part
WHERE (ZCF(:) > 0. .AND. ZRCT(:) > ZRCRAUTC(:)*ZCF(:))
ZHLC_HCF(:) = ZCF(:)
@@ -683,6 +826,9 @@ IF( IMICRO >= 0 ) THEN
END WHERE
ELSEIF (HSUBG_AUCV == 'PDF ') THEN
+#ifdef _OPENACC
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','OPENACC: HSUBG_AUCV="PDF" not yet implemented')
+#endif
!Cloud water is split between high and low part according to a PDF
! 'HLCRECTPDF' : rectangular PDF form
! 'HLCTRIANGPDF' : triangular PDF form
@@ -806,24 +952,30 @@ IF( IMICRO >= 0 ) THEN
ELSE
!wrong CSUBG_PR_PDF case
- WRITE(*,*) 'wrong CSUBG_PR_PDF case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','wrong CSUBG_PR_PDF case')
ENDIF
ELSE
!wrong HSUBG_AUCV case
- WRITE(*,*)'wrong HSUBG_AUCV case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE','wrong HSUBG_AUCV case')
ENDIF
!Diagnostic of precipitation fraction
+!$acc kernels
PRAINFR(:,:,:) = 0.
+!$acc loop independent
DO JL=1,IMICRO
PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
END DO
+!$acc end kernels
+!$acc data copyin(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL)
CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:))
+!$acc end data
+!$acc kernels
+!$acc loop independent
DO JL=1,IMICRO
ZRF(JL)=PRAINFR(I1(JL),I2(JL),I3(JL))
END DO
+!$acc end kernels
!
CALL RAIN_ICE_SLOW(GMICRO, ZINVTSTEP, ZRHODREF, &
ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHODJ, ZZT, ZPRES, &
@@ -840,20 +992,37 @@ IF( IMICRO >= 0 ) THEN
!
!* 3.1 compute the slope parameter Lbda_r
!
+!$acc kernels
!ZLBDAR will be used when we consider rain diluted over the grid box
WHERE( ZRRT(:)>0.0 )
+#ifndef MNH_BITREP
ZLBDAR(:) = XLBR*( ZRHODREF(:)*MAX( ZRRT(:),XRTMIN(3) ) )**XLBEXR
+#else
+ ZLBDAR(:) = XLBR * BR_POW( ZRHODREF(:) * MAX( ZRRT(:), XRTMIN(3) ), XLBEXR )
+#endif
+ ELSEWHERE
+ ZLBDAR(:) = 0.
END WHERE
!ZLBDAR_RF will be used when we consider rain concentrated in its fraction
WHERE( ZRRT(:)>0.0 .AND. ZRF(:)>0.0 )
+#ifndef MNH_BITREP
ZLBDAR_RF(:) = XLBR*( ZRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3) ) )**XLBEXR
+#else
+ ZLBDAR_RF(:) = XLBR * BR_POW( ZRHODREF(:) * MAX( ZRRT(:)/ZRF(:), XRTMIN(3) ), XLBEXR )
+#endif
ELSEWHERE
ZLBDAR_RF(:) = 0.
END WHERE
+
+ !Not necessary but useful for verifications
+ ZUSW(:) = XNEGUNDEF
+!$acc end kernels
!
IF( OWARM ) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
+!$acc kernels
PEVAP3D(:,:,:)= 0.
+!$acc end kernels
CALL RAIN_ICE_WARM(GMICRO, IMICRO, I1, I2, I3, &
ZRHODREF, ZRVT, ZRCT, ZRRT, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
ZRHODJ, ZPRES, ZZT, ZLBDAR, ZLBDAR_RF, ZLVFACT, ZCJ, ZKA, ZDV, ZRF, ZCF, ZTHT, ZTHLT, &
@@ -888,6 +1057,9 @@ IF( IMICRO >= 0 ) THEN
! ----------------------------------------------
!
IF ( KRR == 7 ) THEN
+!$acc kernels
+ ZLBDAH(:) = 0.
+!$acc end kernels
CALL RAIN_ICE_FAST_RH(GMICRO, ZRHODREF, ZRVT, ZRCT, ZRIT, ZRST, ZRGT, ZRHT, ZRHODJ, ZPRES, &
ZZT, ZLBDAS, ZLBDAG, ZLBDAH, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, PRHODJ, PTHS, &
ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, ZUSW)
@@ -907,6 +1079,8 @@ IF( IMICRO >= 0 ) THEN
!
!
!
+!$acc kernels
+!$acc loop independent
DO JL=1,IMICRO
PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL)
PRCS(I1(JL),I2(JL),I3(JL)) = ZRCS(JL)
@@ -920,10 +1094,12 @@ IF( IMICRO >= 0 ) THEN
PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
END DO
IF ( KRR == 7 ) THEN
+!$acc loop independent
DO JL=1,IMICRO
PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL)
END DO
END IF
+!$acc end kernels
!
!
!
@@ -1094,7 +1270,12 @@ ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!sedimentation of rain fraction
-CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
+!$acc kernels
+ZW(:,:,:)=PRRS(:,:,:)*PTSTEP
+!$acc end kernels
+!$acc data copyin(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL)
+CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, ZW)
+!$acc end data
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
@@ -1124,6 +1305,7 @@ IF (MPPDB_INITIALIZED) THEN
END IF
END IF
!
+! !$acc end data
!-------------------------------------------------------------------------------
!
END SUBROUTINE RAIN_ICE
diff --git a/src/MNH/rain_ice_fast_rg.f90 b/src/MNH/rain_ice_fast_rg.f90
index 181b055d3cf88b3cc997d26b402687bd0c2fe69a..3cb5d7cbe72bf55d89f14630c55af1310fdfd390 100644
--- a/src/MNH/rain_ice_fast_rg.f90
+++ b/src/MNH/rain_ice_fast_rg.f90
@@ -37,7 +37,15 @@ use MODD_RAIN_ICE_PARAM, only: NDRYLBDAG, NDRYLBDAR, NDRYLBDAS, X0DEPG, X1DEPG,
XLBRDRYG2, XLBRDRYG3, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XRCFRI
!
use mode_mppdb
-!
+#ifndef _OPENACC
+use mode_tools, only: Countjv
+#else
+use mode_tools, only: Countjv_device
+#endif
+!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
use MODI_BUDGET
!
IMPLICIT NONE
@@ -78,17 +86,36 @@ REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over wat
REAL, DIMENSION(:), intent(out) :: PRDRYG ! Dry growth rate of the graupeln
REAL, DIMENSION(:), intent(out) :: PRWETG ! Wet growth rate of the graupeln
!
+! IN variables
+!
+!$acc declare present(OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCIT, &
+!$acc & PRHODJ, PPRES, PZT, PLBDAR, PLBDAS, PLBDAG, PLSFACT, PLVFACT, &
+!$acc & PCJ, PKA, PDV, PRHODJ3D, PTHS3D) &
+!
+! INOUT variables
+!
+!$acc & present(PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, PUSW) &
+!
+! OUT variables
+!
+!$acc & present(PRDRYG, PRWETG)
+!
!* 0.2 declaration of local variables
!
INTEGER :: IGDRY
INTEGER :: JJ, JL
-INTEGER, DIMENSION(size(PRHODREF)) :: I1
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
-REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
-REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
-REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAR, ZVECLBDAS
-REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
-!
+INTEGER, DIMENSION(:), ALLOCATABLE :: I1
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAR, ZVECLBDAS
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+!
+!$acc declare device_resident(I1, IVEC1, IVEC2, GWORK, ZZW, ZVEC1, ZVEC2, ZVEC3, &
+!$acc & ZVECLBDAG, ZVECLBDAR, ZVECLBDAS, ZZW1)
+!
+!$acc declare copyin(XKER_RDRYG, XKER_SDRYG)
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
@@ -126,56 +153,91 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PUSW,"RAIN_ICE_FAST_RG beg:PUSW")
END IF
!
+ALLOCATE( I1 (size(PRHODREF)) )
+ALLOCATE( GWORK(size(PRHODREF)) )
+ALLOCATE( ZZW (size(PRHODREF)) )
+ALLOCATE( ZZW1 (size(PRHODREF),7) )
+!
!* 6.1 rain contact freezing
!
- WHERE( (PRIT(:)>XRTMIN(4)) .AND. (PRRT(:)>XRTMIN(3)) .AND. &
- (PRIS(:)>0.0) .AND. (PRRS(:)>0.0) )
+!$acc kernels
+ GWORK(:) = PRIT(:)>XRTMIN(4) .AND. PRRT(:)>XRTMIN(3) .AND. PRIS(:)>0.0 .AND. PRRS(:)>0.0
+ WHERE( GWORK(:) )
+#ifndef MNH_BITREP
ZZW1(:,3) = MIN( PRIS(:),XICFRR * PRIT(:) & ! RICFRRG
* PLBDAR(:)**XEXICFRR &
* PRHODREF(:)**(-XCEXVT) )
ZZW1(:,4) = MIN( PRRS(:),XRCFRI * PCIT(:) & ! RRCFRIG
* PLBDAR(:)**XEXRCFRI &
* PRHODREF(:)**(-XCEXVT-1.) )
+#else
+ ZZW1(:,3) = MIN( PRIS(:),XICFRR * PRIT(:) & ! RICFRRG
+ * BR_POW(PLBDAR(:),XEXICFRR) &
+ * BR_POW(PRHODREF(:),-XCEXVT) )
+ ZZW1(:,4) = MIN( PRRS(:),XRCFRI * PCIT(:) & ! RRCFRIG
+ * BR_POW(PLBDAR(:),XEXRCFRI) &
+ * BR_POW(PRHODREF(:),-XCEXVT-1.) )
+#endif
PRIS(:) = PRIS(:) - ZZW1(:,3)
PRRS(:) = PRRS(:) - ZZW1(:,4)
PRGS(:) = PRGS(:) + ZZW1(:,3)+ZZW1(:,4)
PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*RRCFRIG)
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'CFRZ_BU_RRG')
+!$acc end kernels
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), 4,'CFRZ_BU_RTH')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), 8,'CFRZ_BU_RRR')
+ END IF
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), 9,'CFRZ_BU_RRI')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), 11,'CFRZ_BU_RRG')
+ END IF
!
!* 6.2 compute the Dry growth case
!
+!$acc kernels
ZZW1(:,:) = 0.0
- WHERE( PRGT(:)>XRTMIN(6) .AND. PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.0 )
+ GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.0
+ WHERE( GWORK(:) )
+#ifndef MNH_BITREP
ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
+#else
+ ZZW(:) = BR_POW(PLBDAG(:),XCXG-XDG-2.0) * BR_POW(PRHODREF(:),-XCEXVT)
+#endif
ZZW1(:,1) = MIN( PRCS(:),XFCDRYG * PRCT(:) * ZZW(:) ) ! RCDRYG
END WHERE
- WHERE( (PRGT(:)>XRTMIN(6)) .AND. PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0 )
+ GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0
+ WHERE( GWORK(:) )
+#ifndef MNH_BITREP
ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
ZZW1(:,2) = MIN( PRIS(:),XFIDRYG * EXP( XCOLEXIG*(PZT(:)-XTT) ) &
* PRIT(:) * ZZW(:) ) ! RIDRYG
+#else
+ ZZW(:) = BR_POW(PLBDAG(:),XCXG-XDG-2.0) * BR_POW(PRHODREF(:),-XCEXVT)
+ ZZW1(:,2) = MIN( PRIS(:),XFIDRYG * BR_EXP( XCOLEXIG*(PZT(:)-XTT) ) &
+ * PRIT(:) * ZZW(:) ) ! RIDRYG
+#endif
END WHERE
+!$acc end kernels
!
!* 6.2.1 accretion of aggregates on the graupeln
!
- IGDRY = 0
- DO JJ = 1, SIZE(PRST)
- IF ( PRST(JJ)>XRTMIN(5) .AND. PRGT(JJ)>XRTMIN(6) .AND. PRSS(JJ)>0.0 ) THEN
- IGDRY = IGDRY + 1
- I1(IGDRY) = JJ
- END IF
- END DO
+!$acc kernels
+ GWORK(:) = PRST(:)>XRTMIN(5) .AND. PRGT(:)>XRTMIN(6) .AND. PRSS(:)>0.0
+!$acc end kernels
+#ifndef _OPENACC
+ IGDRY = COUNTJV( GWORK(:), I1(:) )
+#else
+ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGDRY )
+#endif
IF( IGDRY>0 ) THEN
!
@@ -191,6 +253,7 @@ END IF
!
!* 6.2.3 select the (PLBDAG,PLBDAS) couplet
!
+!$acc kernels
ZVECLBDAG(1:IGDRY) = PLBDAG(I1(1:IGDRY))
ZVECLBDAS(1:IGDRY) = PLBDAS(I1(1:IGDRY))
!
@@ -199,18 +262,27 @@ END IF
! tabulate the SDRYG-kernel
!
ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
+#ifndef MNH_BITREP
XDRYINTP1G * LOG( ZVECLBDAG(1:IGDRY) ) + XDRYINTP2G ) )
+#else
+ XDRYINTP1G * BR_LOG( ZVECLBDAG(1:IGDRY) ) + XDRYINTP2G ) )
+#endif
IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
!
ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
+#ifndef MNH_BITREP
XDRYINTP1S * LOG( ZVECLBDAS(1:IGDRY) ) + XDRYINTP2S ) )
+#else
+ XDRYINTP1S * BR_LOG( ZVECLBDAS(1:IGDRY) ) + XDRYINTP2S ) )
+#endif
IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
!
!* 6.2.5 perform the bilinear interpolation of the normalized
! SDRYG-kernel
!
+!$acc loop independent
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) ) &
@@ -220,16 +292,28 @@ END IF
* (ZVEC1(JJ) - 1.0)
END DO
!
+!$acc loop independent
DO JJ = 1, IGDRY
JL = I1(JJ)
- ZZW1(JL,3) = MIN( PRSS(JL),XFSDRYG*ZVEC3(JJ) & ! RSDRYG
- * EXP( XCOLEXSG*(PZT(JL)-XTT) ) &
- *( ZVECLBDAS(JJ)**(XCXS-XBS) )*( ZVECLBDAG(JJ)**XCXG ) &
- *( PRHODREF(JL)**(-XCEXVT-1.) ) &
- *( XLBSDRYG1/( ZVECLBDAG(JJ)**2 ) + &
- XLBSDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAS(JJ) ) + &
- XLBSDRYG3/( ZVECLBDAS(JJ)**2) ) )
+#ifndef MNH_BITREP
+ ZZW1(JL,3) = MIN( PRSS(JL),XFSDRYG*ZVEC3(JJ) & ! RSDRYG
+ * EXP( XCOLEXSG*(PZT(JL)-XTT) ) &
+ * ZVECLBDAS(JJ)**(XCXS-XBS) * ZVECLBDAG(JJ)**XCXG &
+ * PRHODREF(JL)**(-XCEXVT-1.) &
+ * ( XLBSDRYG1 / ZVECLBDAG(JJ)**2 &
+ + XLBSDRYG2 / ( ZVECLBDAG(JJ) * ZVECLBDAS(JJ) ) &
+ + XLBSDRYG3 / ZVECLBDAS(JJ)**2 ) )
+#else
+ ZZW1(JL,3) = MIN( PRSS(JL),XFSDRYG*ZVEC3(JJ) & ! RSDRYG
+ * BR_EXP( XCOLEXSG*(PZT(JL)-XTT) ) &
+ * BR_POW(ZVECLBDAS(JJ),XCXS-XBS) * BR_POW(ZVECLBDAG(JJ),XCXG) &
+ * BR_POW(PRHODREF(JL),-XCEXVT-1.) &
+ * ( XLBSDRYG1 / BR_P2(ZVECLBDAG(JJ)) &
+ + XLBSDRYG2 / ( ZVECLBDAG(JJ) * ZVECLBDAS(JJ) ) &
+ + XLBSDRYG3 / BR_P2(ZVECLBDAS(JJ)) ) )
+#endif
END DO
+!$acc end kernels
DEALLOCATE(ZVECLBDAS)
DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
@@ -241,13 +325,14 @@ END IF
!
!* 6.2.6 accretion of raindrops on the graupeln
!
- IGDRY = 0
- DO JJ = 1, SIZE(PRRT)
- IF ( PRRT(JJ)>XRTMIN(3) .AND. PRGT(JJ)>XRTMIN(6) .AND. PRRS(JJ)>0.0 ) THEN
- IGDRY = IGDRY + 1
- I1(IGDRY) = JJ
- END IF
- END DO
+!$acc kernels
+ GWORK(:) = PRRT(:)>XRTMIN(3) .AND. PRGT(:)>XRTMIN(6) .AND. PRSS(:)>0.0
+!$acc end kernels
+#ifndef _OPENACC
+ IGDRY = COUNTJV( GWORK(:), I1(:) )
+#else
+ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGDRY )
+#endif
!
IF( IGDRY>0 ) THEN
!
@@ -263,6 +348,7 @@ END IF
!
!* 6.2.8 select the (PLBDAG,PLBDAR) couplet
!
+!$acc kernels
ZVECLBDAG(1:IGDRY) = PLBDAG(I1(1:IGDRY))
ZVECLBDAR(1:IGDRY) = PLBDAR(I1(1:IGDRY))
!
@@ -271,18 +357,27 @@ END IF
! tabulate the RDRYG-kernel
!
ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
+#ifndef MNH_BITREP
XDRYINTP1G * LOG( ZVECLBDAG(1:IGDRY) ) + XDRYINTP2G ) )
+#else
+ XDRYINTP1G * BR_LOG( ZVECLBDAG(1:IGDRY) ) + XDRYINTP2G ) )
+#endif
IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
!
ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
+#ifndef MNH_BITREP
XDRYINTP1R * LOG( ZVECLBDAR(1:IGDRY) ) + XDRYINTP2R ) )
+#else
+ XDRYINTP1R * BR_LOG( ZVECLBDAR(1:IGDRY) ) + XDRYINTP2R ) )
+#endif
IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
!
!* 6.2.10 perform the bilinear interpolation of the normalized
! RDRYG-kernel
!
+!$acc loop independent
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) ) &
@@ -292,15 +387,26 @@ END IF
* (ZVEC1(JJ) - 1.0)
END DO
!
+!$acc loop independent
DO JJ = 1, IGDRY
JL = I1(JJ)
- ZZW1(JL,4) = MIN( PRRS(JL),XFRDRYG*ZVEC3(JJ) & ! RRDRYG
- *( ZVECLBDAR(JJ)**(-4) )*( ZVECLBDAG(JJ)**XCXG ) &
- *( PRHODREF(JL)**(-XCEXVT-1.) ) &
- *( XLBRDRYG1/( ZVECLBDAG(JJ)**2 ) + &
- XLBRDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAR(JJ) ) + &
- XLBRDRYG3/( ZVECLBDAR(JJ)**2) ) )
+#ifndef MNH_BITREP
+ ZZW1(JL,4) = MIN( PRRS(JL),XFRDRYG*ZVEC3(JJ) & ! RRDRYG
+ * ZVECLBDAR(JJ)**(-4) * ZVECLBDAG(JJ)**XCXG &
+ * PRHODREF(JL)**(-XCEXVT-1.) &
+ * ( XLBRDRYG1/ ZVECLBDAG(JJ)**2 &
+ + XLBRDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAR(JJ) ) &
+ + XLBRDRYG3/ ZVECLBDAR(JJ)**2 ) )
+#else
+ ZZW1(JL,4) = MIN( PRRS(JL),XFRDRYG*ZVEC3(JJ) & ! RRDRYG
+ * BR_POW(ZVECLBDAR(JJ),-4.) * BR_POW(ZVECLBDAG(JJ),XCXG) &
+ * BR_POW(PRHODREF(JL),-XCEXVT-1.) &
+ * ( XLBRDRYG1/ BR_P2(ZVECLBDAG(JJ)) &
+ + XLBRDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAR(JJ) ) &
+ + XLBRDRYG3/ BR_P2(ZVECLBDAR(JJ)) ) )
+#endif
END DO
+!$acc end kernels
DEALLOCATE(ZVECLBDAR)
DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
@@ -310,16 +416,25 @@ END IF
DEALLOCATE(ZVEC1)
END IF
!
+!$acc kernels
PRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
!
!* 6.3 compute the Wet growth case
!
PRWETG(:) = 0.0
- WHERE( PRGT(:)>XRTMIN(6) )
+ GWORK(:) = PRGT(:)>XRTMIN(6)
+ WHERE( GWORK(:) )
+#ifndef MNH_BITREP
ZZW1(:,5) = MIN( PRIS(:), &
ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(PZT(:)-XTT)) ) ) ! RIWETG
ZZW1(:,6) = MIN( PRSS(:), &
ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(PZT(:)-XTT)) ) ) ! RSWETG
+#else
+ ZZW1(:,5) = MIN( PRIS(:), &
+ ZZW1(:,2) / (XCOLIG*BR_EXP(XCOLEXIG*(PZT(:)-XTT)) ) ) ! RIWETG
+ ZZW1(:,6) = MIN( PRSS(:), &
+ ZZW1(:,3) / (XCOLSG*BR_EXP(XCOLEXSG*(PZT(:)-XTT)) ) ) ! RSWETG
+#endif
!
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
@@ -329,8 +444,13 @@ END IF
! compute RWETG
!
PRWETG(:)=MAX( 0.0, &
+#ifndef MNH_BITREP
( ZZW(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + &
+#else
+ ( ZZW(:) * ( X0DEPG* BR_POW(PLBDAG(:),XEX0DEPG) + &
+ X1DEPG*PCJ(:)*BR_POW(PLBDAG(:),XEX1DEPG) ) + &
+#endif
( ZZW1(:,5)+ZZW1(:,6) ) * &
( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / &
( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) )
@@ -339,9 +459,8 @@ END IF
!* 6.4 Select Wet or Dry case
!
IF ( KRR == 7 ) THEN
- WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
- .AND. & ! Wet
- PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ) ! case
+ GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT .and. PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ! Wet case
+ WHERE( GWORK(:) )
ZZW(:) = PRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
!
! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
@@ -368,9 +487,8 @@ END IF
! f(L_f*(RCWETG+RRWETG))
END WHERE
ELSE IF( KRR == 6 ) THEN
- WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
- .AND. & ! Wet
- PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ) ! case
+ GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT .AND. PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ! Wet case
+ WHERE( GWORK(:) )
PRCS(:) = PRCS(:) - ZZW1(:,1)
PRIS(:) = PRIS(:) - ZZW1(:,5)
PRSS(:) = PRSS(:) - ZZW1(:,6)
@@ -381,34 +499,42 @@ END IF
! f(L_f*(RCWETG+RRWETG))
END WHERE
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'WETG_BU_RRG')
+!$acc end kernels
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'WETG_BU_RTH')
+ END IF
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'WETG_BU_RRC')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'WETG_BU_RRR')
+ END IF
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'WETG_BU_RRI')
+ END IF
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'WETG_BU_RRS')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'WETG_BU_RRG')
+ END IF
IF ( KRR == 7 ) THEN
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 12,'WETG_BU_RRH')
+ IF (LBUDGET_RH) THEN
+!$acc update self(PRHS)
+ CALL BUDGET (UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),12,'WETG_BU_RRH')
+ END IF
END IF
!
- WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
- .AND. &
- PRDRYG(:)<PRWETG(:) .AND. PRDRYG(:)>0.0 ) ! Dry
+!$acc kernels
+ GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT .AND. PRDRYG(:)<PRWETG(:) .AND. PRDRYG(:)>0.0 ! Dry case
+ WHERE( GWORK(:) )
PRCS(:) = PRCS(:) - ZZW1(:,1)
PRIS(:) = PRIS(:) - ZZW1(:,2)
PRSS(:) = PRSS(:) - ZZW1(:,3)
@@ -417,24 +543,31 @@ END IF
PTHS(:) = PTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(PLSFACT(:)-PLVFACT(:)) !
! f(L_f*(RCDRYG+RRDRYG))
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'DRYG_BU_RRG')
+!$acc end kernels
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'DRYG_BU_RTH')
+ END IF
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'DRYG_BU_RRC')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'DRYG_BU_RRR')
+ END IF
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'DRYG_BU_RRI')
+ END IF
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'DRYG_BU_RRS')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'DRYG_BU_RRG')
+ END IF
!
! WHERE ( PZT(:) > XTT ) ! RSWETG case only
! PRSS(:) = PRSS(:) - ZZW1(:,6)
@@ -443,7 +576,9 @@ END IF
!
!* 6.5 Melting of the graupeln
!
- WHERE( PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0 .AND. PZT(:)>XTT )
+!$acc kernels
+ GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0 .AND. PZT(:)>XTT
+ WHERE( GWORK(:) )
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
@@ -452,8 +587,13 @@ END IF
! compute RGMLTR
!
ZZW(:) = MIN( PRGS(:), MAX( 0.0,( -ZZW(:) * &
+#ifndef MNH_BITREP
( X0DEPG* PLBDAG(:)**XEX0DEPG + &
X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - &
+#else
+ ( X0DEPG* BR_POW(PLBDAG(:),XEX0DEPG) + &
+ X1DEPG*PCJ(:)*BR_POW(PLBDAG(:),XEX1DEPG) ) - &
+#endif
( ZZW1(:,1)+ZZW1(:,4) ) * &
( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
( PRHODREF(:)*XLMTT ) ) )
@@ -461,15 +601,19 @@ END IF
PRGS(:) = PRGS(:) - ZZW(:)
PTHS(:) = PTHS(:) - ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RGMLTR))
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'GMLT_BU_RRG')
+!$acc end kernels
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'GMLT_BU_RTH')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'GMLT_BU_RRR')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'GMLT_BU_RRG')
+ END IF
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/rain_ice_fast_rh.f90 b/src/MNH/rain_ice_fast_rh.f90
index 76f87fc07633dce60a3fb6a6649f8fa9985efd34..8ee84985e62edc0f257cd8f32593110fe35a67be 100644
--- a/src/MNH/rain_ice_fast_rh.f90
+++ b/src/MNH/rain_ice_fast_rh.f90
@@ -35,7 +35,16 @@ use MODD_RAIN_ICE_PARAM, only: NWETLBDAG, NWETLBDAH, NWETLBDAS, X0DEPH, X1DEPH,
XWETINTP1G, XWETINTP1H, XWETINTP1S, XWETINTP2G, XWETINTP2H, XWETINTP2S
!
use mode_mppdb
-!
+use mode_msg
+#ifndef _OPENACC
+use mode_tools, only: Countjv
+#else
+use mode_tools, only: Countjv_device
+#endif
+!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
use MODI_BUDGET
!
IMPLICIT NONE
@@ -72,19 +81,43 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over water
!
+! IN variables
+!
+!$acc declare present(OMICRO, PRHODREF, PRVT, PRCT, PRIT, PRST, PRGT, PRHT, &
+!$acc & PRHODJ, PPRES, PZT, PLBDAS, PLBDAG, PLSFACT, PLVFACT, &
+!$acc & PCJ, PKA, PDV, PRHODJ3D, PTHS3D) &
+!
+! INOUT variables
+!
+!$acc & present(PLBDAH, PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, PUSW)
+!
+! OUT variables
+!
+!NONE
+!
!* 0.2 declaration of local variables
!
INTEGER :: IHAIL, IGWET
INTEGER :: JJ, JL
-INTEGER, DIMENSION(size(PRHODREF)) :: I1H, I1W
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
-REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
-REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAH, ZVECLBDAS
-REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
-REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
+INTEGER, DIMENSION(:), ALLOCATABLE :: I1H, I1W
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAH, ZVECLBDAS
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+!
+!$acc declare device_resident(I1H, I1W, IVEC1, IVEC2, GWORK, ZVEC1, ZVEC2, ZVEC3, &
+!$acc & ZVECLBDAG, ZVECLBDAH, ZVECLBDAS, ZZW, ZZW1)
+!
+!$acc declare copyin(XKER_GWETH, XKER_SWETH)
!
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+CALL PRINT_MSG(NVERB_ERROR,'GEN','RAIN_ICE_FAST_RH','OPENACC: not yet tested')
+#endif
+!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(OMICRO,"RAIN_ICE_FAST_RH beg:OMICRO")
@@ -119,20 +152,29 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PUSW,"RAIN_ICE_FAST_RH beg:PUSW")
END IF
!
- IHAIL = 0
- DO JJ = 1, SIZE(PRHT)
- IF ( PRHT(JJ)>XRTMIN(7) ) THEN
- IHAIL = IHAIL + 1
- I1H(IHAIL) = JJ
- END IF
- END DO
+ALLOCATE( I1H (size(PRHODREF)) )
+ALLOCATE( I1W (size(PRHODREF)) )
+ALLOCATE( GWORK(size(PRHODREF)) )
+ALLOCATE( ZZW (size(PRHODREF)) )
+ALLOCATE( ZZW1 (size(PRHODREF),7) )
+!
+!$acc kernels
+ GWORK(:) = PRHT(:)>XRTMIN(7)
+!$acc end kernels
+#ifndef _OPENACC
+ IHAIL = COUNTJV( GWORK(:), I1H(:) )
+#else
+ CALL COUNTJV_DEVICE( GWORK(:), I1H(:), IHAIL )
+#endif
!
IF( IHAIL>0 ) THEN
!
!* 7.2 compute the Wet growth of hail
!
+!$acc kernels
ZZW1(:,:) = 0.0
!
+!$acc loop independent
DO JJ = 1, IHAIL
JL = I1H(JJ)
PLBDAH(JL) = XLBH * ( PRHODREF(JL) * MAX( PRHT(JL), XRTMIN(7) ) )**XLBEXH
@@ -147,17 +189,18 @@ END IF
ZZW1(JL,2) = MIN( PRIS(JL),XFWETH * PRIT(JL) * ZZW(JL) ) ! RIWETH
END IF
END DO
+!$acc end kernels
!
!* 7.2.1 accretion of aggregates on the hailstones
!
- IGWET = 0
- DO JJ = 1, IHAIL
- JL = I1H(JJ)
- IF ( PRST(JL)>XRTMIN(5) .AND. PRSS(JL)>0.0 ) THEN
- IGWET = IGWET + 1
- I1W(IGWET) = JL
- END IF
- END DO
+!$acc kernels
+ GWORK(1:IHAIL) = PRST(I1H(1:IHAIL))>XRTMIN(5) .AND. PRSS(I1H(1:IHAIL))>0.0
+!$acc end kernels
+#ifndef _OPENACC
+ IGWET = COUNTJV( GWORK(1:IHAIL), I1W(:) )
+#else
+ CALL COUNTJV_DEVICE( GWORK(1:IHAIL), I1W(:), IGWET )
+#endif
!
IF( IGWET>0 ) THEN
!
@@ -173,6 +216,7 @@ END IF
!
!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
!
+!$acc kernels
ZVECLBDAH(1:IGWET) = PLBDAH(I1W(1:IGWET))
ZVECLBDAS(1:IGWET) = PLBDAS(I1W(1:IGWET))
!
@@ -193,6 +237,7 @@ END IF
!* 7.2.5 perform the bilinear interpolation of the normalized
! SWETH-kernel
!
+!$acc loop independent
DO JJ = 1,IGWET
ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
@@ -202,6 +247,7 @@ END IF
* (ZVEC1(JJ) - 1.0)
END DO
!
+!$acc loop independent
DO JJ = 1, IGWET
JL = I1W(JJ)
ZZW1(JL,3) = MIN( PRSS(JL),XFSWETH*ZVEC3(JJ) & ! RSWETH
@@ -211,6 +257,7 @@ END IF
XLBSWETH2/( ZVECLBDAH(JJ) * ZVECLBDAS(JJ) ) + &
XLBSWETH3/( ZVECLBDAS(JJ)**2) ) )
END DO
+!$acc end kernels
DEALLOCATE(ZVECLBDAS)
DEALLOCATE(ZVECLBDAH)
DEALLOCATE(IVEC2)
@@ -222,14 +269,14 @@ END IF
!
!* 7.2.6 accretion of graupeln on the hailstones
!
- IGWET = 0
- DO JJ = 1, IHAIL
- JL = I1H(JJ)
- IF ( PRGT(JL)>XRTMIN(6) .AND. PRGS(JL)>0.0 ) THEN
- IGWET = IGWET + 1
- I1W(IGWET) = JL
- END IF
- END DO
+!$acc kernels
+ GWORK(1:IHAIL) = PRGT(I1H(1:IHAIL))>XRTMIN(6) .AND. PRGS(I1H(1:IHAIL))>0.0
+!$acc end kernels
+#ifndef _OPENACC
+ IGWET = COUNTJV( GWORK(1:IHAIL), I1W(:) )
+#else
+ CALL COUNTJV_DEVICE( GWORK(1:IHAIL), I1W(:), IGWET )
+#endif
!
IF( IGWET>0 ) THEN
!
@@ -245,6 +292,7 @@ END IF
!
!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
!
+!$acc kernels
ZVECLBDAG(1:IGWET) = PLBDAG(I1W(1:IGWET))
ZVECLBDAH(1:IGWET) = PLBDAH(I1W(1:IGWET))
!
@@ -265,6 +313,7 @@ END IF
!* 7.2.10 perform the bilinear interpolation of the normalized
! GWETH-kernel
!
+!$acc loop independent
DO JJ = 1,IGWET
ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
@@ -274,6 +323,7 @@ END IF
* (ZVEC1(JJ) - 1.0)
END DO
!
+!$acc loop independent
DO JJ = 1, IGWET
JL = I1W(JJ)
ZZW1(JL,5) = MAX(MIN( PRGS(JL),XFGWETH*ZVEC3(JJ) & ! RGWETH
@@ -283,6 +333,7 @@ END IF
XLBGWETH2/( ZVECLBDAH(JJ) * ZVECLBDAG(JJ) ) + &
XLBGWETH3/( ZVECLBDAG(JJ)**2) ) ),0. )
END DO
+!$acc end kernels
DEALLOCATE(ZVECLBDAH)
DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
@@ -294,6 +345,8 @@ END IF
!
!* 7.3 compute the Wet growth of hail
!
+!$acc kernels
+!$acc loop independent
DO JJ = 1, IHAIL
JL = I1H(JJ)
IF ( PZT(JL)<XTT ) THEN
@@ -335,28 +388,36 @@ END IF
END IF
END IF
END DO
+!$acc end kernels
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
- 4,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 12,'WETH_BU_RRH')
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'WETH_BU_RTH')
+ END IF
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'WETH_BU_RRC')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'WETH_BU_RRR')
+ END IF
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'WETH_BU_RRI')
+ END IF
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'WETH_BU_RRS')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'WETH_BU_RRG')
+ END IF
+ IF (LBUDGET_RH) THEN
+!$acc update self(PRHS)
+ CALL BUDGET (UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),12,'WETH_BU_RRH')
+ END IF
!
!
! ici LRECONVH et un flag pour autoriser une reconversion partielle de
@@ -390,6 +451,8 @@ END IF
!
!* 7.5 Melting of the hailstones
!
+!$acc kernels
+!$acc loop independent
DO JJ = 1, IHAIL
JL = I1H(JJ)
IF( PRHS(JL)>0.0 .AND. PZT(JL)>XTT ) THEN
@@ -409,17 +472,21 @@ END IF
PTHS(JL) = PTHS(JL) - ZZW(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RHMLTR))
END IF
END DO
+!$acc end kernels
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
- 4,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 12,'HMLT_BU_RRH')
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'HMLT_BU_RTH')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'HMLT_BU_RRR')
+ END IF
+ IF (LBUDGET_RH) THEN
+!$acc update self(PRHS)
+ CALL BUDGET (UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),12,'HMLT_BU_RRH')
+ END IF
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/rain_ice_fast_ri.f90 b/src/MNH/rain_ice_fast_ri.f90
index 73a49cf4357ab0901f35722de970beb48dbe050e..330bedd35c5e26bc0a17bc5db86b931dc6caad9c 100644
--- a/src/MNH/rain_ice_fast_ri.f90
+++ b/src/MNH/rain_ice_fast_ri.f90
@@ -30,6 +30,9 @@ use MODD_RAIN_ICE_PARAM, only: X0DEPI, X2DEPI
!
use mode_mppdb
!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
use MODI_BUDGET
!
IMPLICIT NONE
@@ -53,9 +56,27 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
!
+! IN variables
+!
+!$acc declare present(OMICRO, PRHODREF, PRIT, &
+!$acc & PRHODJ, PZT, PSSI, PLSFACT, PLVFACT, &
+!$acc & PAI, PCJ, PRHODJ3D, PTHS3D) &
+!
+! INOUT variables
+!
+!$acc & present(PCIT, PRCS, PRIS, PTHS)
+!
+! OUT variables
+!
+!NONE
+!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
+!
+!$acc declare device_resident( GWORK, ZZW )
+!
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
@@ -79,43 +100,64 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_FAST_RI beg:PTHS")
END IF
!
+ALLOCATE( GWORK(size(PRHODREF)) )
+ALLOCATE( ZZW (size(PRHODREF)) )
+!
!* 7.1 cloud ice melting
!
- WHERE( PRIS(:)>0.0 .AND. PZT(:)>XTT )
+!$acc kernels
+ GWORK(:) = PRIS(:)>0.0 .AND. PZT(:)>XTT
+ WHERE( GWORK(:) )
PRCS(:) = PRCS(:) + PRIS(:)
PTHS(:) = PTHS(:) - PRIS(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC))
PRIS(:) = 0.0
PCIT(:) = 0.0
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'IMLT_BU_RRI')
+!$acc end kernels
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'IMLT_BU_RTH')
+ END IF
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'IMLT_BU_RRC')
+ END IF
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'IMLT_BU_RRI')
+ END IF
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
- WHERE( PRCS(:)>0.0 .AND. PSSI(:)>0.0 .AND. PRIT(:)>XRTMIN(4) .AND. PCIT(:)>0.0 )
+!$acc kernels
+ GWORK(:) = PRCS(:)>0.0 .AND. PSSI(:)>0.0 .AND. PRIT(:)>XRTMIN(4) .AND. PCIT(:)>0.0
+ WHERE( GWORK(:) )
+#ifndef MNH_BITREP
ZZW(:) = MIN(1.E8,XLBI*( PRHODREF(:)*PRIT(:)/PCIT(:) )**XLBEXI) ! Lbda_i
ZZW(:) = MIN( PRCS(:),( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
( X0DEPI/ZZW(:) + X2DEPI*PCJ(:)*PCJ(:)/ZZW(:)**(XDI+2.0) ) )
+#else
+ ZZW(:) = MIN(1.E8,XLBI*BR_POW( PRHODREF(:)*PRIT(:)/PCIT(:), XLBEXI ) ) ! Lbda_i
+ ZZW(:) = MIN( PRCS(:),( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
+ ( X0DEPI/ZZW(:) + X2DEPI*PCJ(:)*PCJ(:)/BR_POW(ZZW(:),XDI+2.0) ) )
+#endif
PRCS(:) = PRCS(:) - ZZW(:)
PRIS(:) = PRIS(:) + ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCBERI))
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'BERFI_BU_RRI')
+!$acc end kernels
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'BERFI_BU_RTH')
+ END IF
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'BERFI_BU_RRC')
+ END IF
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'BERFI_BU_RRI')
+ END IF
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/rain_ice_fast_rs.f90 b/src/MNH/rain_ice_fast_rs.f90
index 6c93ba93b32a440f58382615a5556fcc53335bb6..03bae3627ac94f6d79bb2ae1e228952ee972b148 100644
--- a/src/MNH/rain_ice_fast_rs.f90
+++ b/src/MNH/rain_ice_fast_rs.f90
@@ -36,7 +36,15 @@ use MODD_RAIN_ICE_PARAM, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XA
XRIMINTP1, XRIMINTP2, XSRIMCG
!
use mode_mppdb
-!
+#ifndef _OPENACC
+use mode_tools, only: Countjv
+#else
+use mode_tools, only: Countjv_device
+#endif
+!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
use MODI_BUDGET
!
IMPLICIT NONE
@@ -69,16 +77,36 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. sour
REAL, DIMENSION(:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
!
+! IN variables
+!
+!$acc declare present(OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRST, PRHODJ, &
+!$acc & PPRES, PZT, PLBDAR, PLBDAS, PLSFACT, PLVFACT, &
+!$acc & PCJ, PKA, PDV, PRHODJ3D, PTHS3D) &
+!
+! INOUT variables
+!
+!$acc & present(PRCS, PRRS, PRSS, PRGS, PTHS)
+!
+! OUT variables
+!
+!NONE
+!
!* 0.2 declaration of local variables
!
-INTEGER :: IGRIM, IGACC
-INTEGER :: JJ, JL
-INTEGER, DIMENSION(size(PRHODREF)) :: I1
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
-REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
-REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
-REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAR, ZVECLBDAS
+INTEGER :: IGRIM, IGACC
+INTEGER :: JJ, JL
+INTEGER, DIMENSION(:), ALLOCATABLE :: I1
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAR, ZVECLBDAS
REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
+!
+!$acc declare device_resident(I1, IVEC1, IVEC2, GWORK, ZZW, ZVEC1, ZVEC2, ZVEC3, &
+!$acc & ZVECLBDAR, ZVECLBDAS, ZZW1, ZZW2, ZZW3, ZZW4)
+!
+!$acc declare copyin(XKER_RACCS, XKER_RACCSS, XKER_SACCRG)
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
@@ -109,15 +137,20 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_FAST_RS beg:PTHS")
END IF
!
+ALLOCATE( I1 (size(PRHODREF)) )
+ALLOCATE( GWORK(size(PRHODREF)) )
+ALLOCATE( ZZW (size(PRHODREF)) )
+!
!* 5.1 cloud droplet riming of the aggregates
!
- IGRIM = 0
- DO JJ = 1, SIZE(PRCT)
- IF ( PRCT(JJ)>XRTMIN(2) .AND. PRST(JJ)>XRTMIN(5) .AND. PRCS(JJ)>0.0 .AND. PZT(JJ)<XTT ) THEN
- IGRIM = IGRIM + 1
- I1(IGRIM) = JJ
- END IF
- END DO
+!$acc kernels
+GWORK(:) = PRCT(:)>XRTMIN(2) .AND. PRST(:)>XRTMIN(5) .AND. PRCS(:)>0.0 .AND. PZT(:)<XTT
+!$acc end kernels
+#ifndef _OPENACC
+IGRIM = COUNTJV( GWORK(:), I1(:) )
+#else
+CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
+#endif
!
IF( IGRIM>0 ) THEN
!
@@ -133,6 +166,7 @@ END IF
!
! 5.1.1 select the PLBDAS
!
+!$acc kernels
ZVECLBDAS(1:IGRIM) = PLBDAS(I1(1:IGRIM))
!
! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
@@ -140,7 +174,11 @@ END IF
! gamma function
!
ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
+#ifndef MNH_BITREP
XRIMINTP1 * LOG( ZVECLBDAS(1:IGRIM) ) + XRIMINTP2 ) )
+#else
+ XRIMINTP1 * BR_LOG( ZVECLBDAS(1:IGRIM) ) + XRIMINTP2 ) )
+#endif
IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
!
@@ -152,12 +190,20 @@ END IF
!
! 5.1.4 riming of the small sized aggregates
!
+!$acc loop independent
DO JJ = 1, IGRIM
JL = I1(JJ)
+#ifndef MNH_BITREP
+ ZZW1(JJ) = MIN( PRCS(JL), &
+ XCRIMSS * ZVEC1(JJ) * PRCT(JL) & ! RCRIMSS
+ * ZVECLBDAS(JJ)**XEXCRIMSS &
+ * PRHODREF(JL)**(-XCEXVT) )
+#else
ZZW1(JJ) = MIN( PRCS(JL), &
- XCRIMSS * ZVEC1(JJ) * PRCT(JL) & ! RCRIMSS
- * ZVECLBDAS(JJ)**XEXCRIMSS &
- * PRHODREF(JL)**(-XCEXVT) )
+ XCRIMSS * ZVEC1(JJ) * PRCT(JL) & ! RCRIMSS
+ * BR_POW(ZVECLBDAS(JJ),XEXCRIMSS) &
+ * BR_POW(PRHODREF(JL),-XCEXVT) )
+#endif
PRCS(JL) = PRCS(JL) - ZZW1(JJ)
PRSS(JL) = PRSS(JL) + ZZW1(JJ)
PTHS(JL) = PTHS(JL) + ZZW1(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RCRIMSS))
@@ -172,23 +218,36 @@ END IF
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
!
+!$acc loop independent
DO JJ = 1, IGRIM
JL = I1(JJ)
IF ( PRSS(JL) > 0.0 ) THEN
- ZZW2(JJ) = MIN( PRCS(JL), &
- XCRIMSG * PRCT(JL) & ! RCRIMSG
- * ZVECLBDAS(JJ)**XEXCRIMSG &
- * PRHODREF(JL)**(-XCEXVT) &
- - ZZW1(JJ) )
- ZZW3(JJ) = MIN( PRSS(JL), &
- XSRIMCG * ZVECLBDAS(JJ)**XEXSRIMCG & ! RSRIMCG
+#ifndef MNH_BITREP
+ ZZW2(JJ) = MIN( PRCS(JL), &
+ XCRIMSG * PRCT(JL) & ! RCRIMSG
+ * ZVECLBDAS(JJ)**XEXCRIMSG &
+ * PRHODREF(JL)**(-XCEXVT) &
+ - ZZW1(JJ) )
+ ZZW3(JJ) = MIN( PRSS(JL), &
+ XSRIMCG * ZVECLBDAS(JJ)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZVEC1(JJ) )/(PTSTEP*PRHODREF(JL)) )
+#else
+ ZZW2(JJ) = MIN( PRCS(JL), &
+ XCRIMSG * PRCT(JL) & ! RCRIMSG
+ * BR_POW(ZVECLBDAS(JJ),XEXCRIMSG) &
+ * BR_POW(PRHODREF(JL),-XCEXVT) &
+ - ZZW1(JJ) )
+ ZZW3(JJ) = MIN( PRSS(JL), &
+ XSRIMCG * BR_POW(ZVECLBDAS(JJ),XEXSRIMCG) & ! RSRIMCG
* (1.0 - ZVEC1(JJ) )/(PTSTEP*PRHODREF(JL)) )
+#endif
PRCS(JL) = PRCS(JL) - ZZW2(JJ)
PRSS(JL) = PRSS(JL) - ZZW3(JJ)
PRGS(JL) = PRGS(JL) + ZZW2(JJ)+ZZW3(JJ)
PTHS(JL) = PTHS(JL) + ZZW2(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RCRIMSG))
END IF
END DO
+!$acc end kernels
DEALLOCATE(ZZW3)
DEALLOCATE(ZZW2)
DEALLOCATE(ZZW1)
@@ -197,28 +256,33 @@ END IF
DEALLOCATE(ZVEC1)
DEALLOCATE(ZVECLBDAS)
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'RIM_BU_RRG')
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'RIM_BU_RTH')
+ END IF
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'RIM_BU_RRC')
+ END IF
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'RIM_BU_RRS')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'RIM_BU_RRG')
+ END IF
!
!* 5.2 rain accretion onto the aggregates
!
- IGACC = 0
- DO JJ = 1, SIZE(PRRT)
- IF ( PRRT(JJ)>XRTMIN(3) .AND. PRST(JJ)>XRTMIN(5) .AND. PRRS(JJ)>0.0 .AND. PZT(JJ)<XTT ) THEN
- IGACC = IGACC + 1
- I1(IGACC) = JJ
- END IF
- END DO
+!$acc kernels
+ GWORK(:) = PRRT(:)>XRTMIN(3) .AND. PRST(:)>XRTMIN(5) .AND. PRRS(:)>0.0 .AND. PZT(:)<XTT
+!$acc end kernels
+#ifndef _OPENACC
+ IGACC = COUNTJV( GWORK(:), I1(:) )
+#else
+ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGACC )
+#endif
!
IF( IGACC>0 ) THEN
!
@@ -237,6 +301,7 @@ END IF
!
! 5.2.1 select the (PLBDAS,PLBDAR) couplet
!
+!$acc kernels
ZVECLBDAS(1:IGACC) = PLBDAS(I1(1:IGACC))
ZVECLBDAR(1:IGACC) = PLBDAR(I1(1:IGACC))
!
@@ -245,18 +310,27 @@ END IF
! tabulate the RACCSS-kernel
!
ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, &
+#ifndef MNH_BITREP
XACCINTP1S * LOG( ZVECLBDAS(1:IGACC) ) + XACCINTP2S ) )
+#else
+ XACCINTP1S * BR_LOG( ZVECLBDAS(1:IGACC) ) + XACCINTP2S ) )
+#endif
IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
!
ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
+#ifndef MNH_BITREP
XACCINTP1R * LOG( ZVECLBDAR(1:IGACC) ) + XACCINTP2R ) )
+#else
+ XACCINTP1R * BR_LOG( ZVECLBDAR(1:IGACC) ) + XACCINTP2R ) )
+#endif
IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
!
! 5.2.3 perform the bilinear interpolation of the normalized
! RACCSS-kernel
!
+!$acc loop independent
DO JJ = 1,IGACC
ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
@@ -268,13 +342,22 @@ END IF
!
! 5.2.4 raindrop accretion on the small sized aggregates
!
+!$acc loop independent
DO JJ = 1, IGACC
JL = I1(JJ)
- ZZW2(JJ) = & !! coef of RRACCS
- XFRACCSS*( ZVECLBDAS(JJ)**XCXS )*( PRHODREF(JL)**(-XCEXVT-1.) ) &
- *( XLBRACCS1/((ZVECLBDAS(JJ)**2) ) + &
- XLBRACCS2/( ZVECLBDAS(JJ) * ZVECLBDAR(JJ) ) + &
- XLBRACCS3/( (ZVECLBDAR(JJ)**2)) )/ZVECLBDAR(JJ)**4
+#ifndef MNH_BITREP
+ ZZW2(JJ) = & !! coef of RRACCS
+ XFRACCSS * ZVECLBDAS(JJ)**XCXS * PRHODREF(JL)**(-XCEXVT-1.) &
+ *( XLBRACCS1 / ZVECLBDAS(JJ)**2 &
+ + XLBRACCS2 / ( ZVECLBDAS(JJ) * ZVECLBDAR(JJ) ) &
+ + XLBRACCS3 / ZVECLBDAR(JJ)**2 ) / ZVECLBDAR(JJ)**4
+#else
+ ZZW2(JJ) = & !! coef of RRACCS
+ XFRACCSS * BR_POW(ZVECLBDAS(JJ),XCXS) * BR_POW(PRHODREF(JL),-XCEXVT-1.) &
+ *( XLBRACCS1 / BR_P2(ZVECLBDAS(JJ)) &
+ + XLBRACCS2 / ( ZVECLBDAS(JJ) * ZVECLBDAR(JJ) ) &
+ + XLBRACCS3 / BR_P2(ZVECLBDAR(JJ)) ) / BR_POW(ZVECLBDAR(JJ),4.0)
+#endif
ZZW4(JJ) = MIN( PRRS(JL),ZZW2(JJ)*ZVEC3(JJ) ) ! RRACCSS
PRRS(JL) = PRRS(JL) - ZZW4(JJ)
PRSS(JL) = PRSS(JL) + ZZW4(JJ)
@@ -284,6 +367,7 @@ END IF
! 5.2.4b perform the bilinear interpolation of the normalized
! RACCS-kernel
!
+!$acc loop independent
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) ) &
@@ -292,6 +376,7 @@ END IF
- XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* (ZVEC2(JJ) - 1.0)
END DO
+!$acc loop independent
DO JJ = 1, IGACC
ZZW2(JJ) = ZZW2(JJ) * ZVEC3(JJ)
END DO
@@ -299,6 +384,7 @@ END IF
! 5.2.5 perform the bilinear interpolation of the normalized
! SACCRG-kernel
!
+!$acc loop independent
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) ) &
@@ -311,16 +397,25 @@ END IF
! 5.2.6 raindrop accretion-conversion of the large sized aggregates
! into graupeln
!
+!$acc loop independent
DO JJ = 1, IGACC
JL = I1(JJ)
IF ( PRSS(JL) > 0.0 ) THEN
ZZW2(JJ) = MAX( MIN( PRRS(JL),ZZW2(JJ)-ZZW4(JJ) ),0.0 ) ! RRACCSG
IF ( ZZW2(JJ) > 0.0 ) THEN
- ZZW3(JJ) = MIN( PRSS(JL),XFSACCRG*ZVEC3(JJ)* & ! RSACCRG
- ( ZVECLBDAS(JJ)**(XCXS-XBS) )*( PRHODREF(JL)**(-XCEXVT-1.) ) &
- *( XLBSACCR1/((ZVECLBDAR(JJ)**2) ) + &
- XLBSACCR2/( ZVECLBDAR(JJ) * ZVECLBDAS(JJ) ) + &
- XLBSACCR3/( (ZVECLBDAS(JJ)**2)) )/ZVECLBDAR(JJ) )
+#ifndef MNH_BITREP
+ ZZW3(JJ) = MIN( PRSS(JL),XFSACCRG*ZVEC3(JJ)* & ! RSACCRG
+ ZVECLBDAS(JJ)**(XCXS-XBS) * PRHODREF(JL)**(-XCEXVT-1.) &
+ * ( XLBSACCR1 / ZVECLBDAR(JJ)**2 &
+ + XLBSACCR2 /( ZVECLBDAR(JJ) * ZVECLBDAS(JJ) ) &
+ + XLBSACCR3 / ZVECLBDAS(JJ)**2 ) / ZVECLBDAR(JJ) )
+#else
+ ZZW3(JJ) = MIN( PRSS(JL),XFSACCRG*ZVEC3(JJ)* & ! RSACCRG
+ BR_POW(ZVECLBDAS(JJ),XCXS-XBS) * BR_POW(PRHODREF(JL),-XCEXVT-1.) &
+ * ( XLBSACCR1 / BR_P2(ZVECLBDAR(JJ)) &
+ + XLBSACCR2 /( ZVECLBDAR(JJ) * ZVECLBDAS(JJ) ) &
+ + XLBSACCR3 / BR_P2(ZVECLBDAS(JJ)) ) / ZVECLBDAR(JJ) )
+#endif
PRRS(JL) = PRRS(JL) - ZZW2(JJ)
PRSS(JL) = PRSS(JL) - ZZW3(JJ)
PRGS(JL) = PRGS(JL) + ZZW2(JJ)+ZZW3(JJ)
@@ -329,6 +424,7 @@ END IF
END IF
END IF
END DO
+!$acc end kernels
DEALLOCATE(ZZW4)
DEALLOCATE(ZZW3)
DEALLOCATE(ZZW2)
@@ -340,22 +436,28 @@ END IF
DEALLOCATE(ZVECLBDAS)
DEALLOCATE(ZVECLBDAR)
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'ACC_BU_RRG')
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'ACC_BU_RTH')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'ACC_BU_RRR')
+ END IF
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'ACC_BU_RRS')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'ACC_BU_RRG')
+ END IF
!
!* 5.3 Conversion-Melting of the aggregates
!
- WHERE( PRST(:)>XRTMIN(5) .AND. PRSS(:)>0.0 .AND. PZT(:)>XTT )
+!$acc kernels
+ GWORK(:) = PRST(:)>XRTMIN(5) .AND. PRSS(:)>0.0 .AND. PZT(:)>XTT
+ WHERE( GWORK(:) )
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
@@ -363,10 +465,17 @@ END IF
!
! compute RSMLT
!
+#ifndef MNH_BITREP
ZZW(:) = MIN( PRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
( X0DEPS* PLBDAS(:)**XEX0DEPS + &
X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) ) / &
( PRHODREF(:)*XLMTT ) ) )
+#else
+ ZZW(:) = MIN( PRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPS* BR_POW(PLBDAS(:),XEX0DEPS) + &
+ X1DEPS*PCJ(:)*BR_POW(PLBDAS(:),XEX1DEPS) ) ) / &
+ ( PRHODREF(:)*XLMTT ) ) )
+#endif
!
! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
! because the graupeln produced by this process are still icy!!!
@@ -374,12 +483,15 @@ END IF
PRSS(:) = PRSS(:) - ZZW(:)
PRGS(:) = PRGS(:) + ZZW(:)
END WHERE
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'CMEL_BU_RRG')
+!$acc end kernels
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'CMEL_BU_RRS')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'CMEL_BU_RRG')
+ END IF
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/rain_ice_nucleation.f90 b/src/MNH/rain_ice_nucleation.f90
index 9c2035bd16f2f9b5f693a675ea3f03421e96dd35..db4a4aa290fdf198d4c05516c344a2e263396b5b 100644
--- a/src/MNH/rain_ice_nucleation.f90
+++ b/src/MNH/rain_ice_nucleation.f90
@@ -31,8 +31,15 @@ use MODD_CST, only: XALPI, XALPW, XBETAI, XBETAW, XCI, XCL, XCPD, XC
use MODD_RAIN_ICE_PARAM, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
use mode_mppdb
+#ifndef _OPENACC
use mode_tools, only: Countjv
+#else
+use mode_tools, only: Countjv_device
+#endif
+#ifdef MNH_BITREP
+use modi_bitrep
+#endif
use MODI_BUDGET
IMPLICIT NONE
@@ -61,6 +68,19 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. s
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT ! Temperature
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
!
+! IN variables
+!
+!$acc declare present(PTHT, PPABST, PRHODJ, PRHODREF, PRVT, PRCT, &
+!$acc & PRRT, PRIT, PRST, PRGT, PEXNREF, PRHT) &
+!
+! INOUT variables
+!
+!$acc & present(PCIT, PTHS, PRVS, PRIS) &
+!
+! OUT variables
+!
+!$acc & present(PT)
+!
!* 0.2 declaration of local variables
!
INTEGER :: INEGT
@@ -68,6 +88,7 @@ INTEGER :: JL ! and PACK intrinsics
INTEGER, DIMENSION(SIZE(PEXNREF)) :: I1,I2,I3 ! Used to replace the COUNT
LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: GNEGT ! Test where to compute the HEN process
+REAL :: ZZWMAX
REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
@@ -78,6 +99,10 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: ZW ! work array
!
+!$acc declare device_resident(ZRVT, ZCIT, ZZT, ZPRES, ZZW, ZUSW, ZSSI, ZW)
+!$acc declare device_resident(I1, I2, I3, GNEGT)
+
+!$acc declare copyin(XALPHA1)
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
@@ -104,57 +129,89 @@ END IF
!
! compute the temperature and the pressure
!
-PT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
+!$acc kernels
+#ifndef MNH_BITREP
+PT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** ( XRD / XCPD )
+#else
+PT(:,:,:) = PTHT(:,:,:) * BR_POW( PPABST(:,:,:) / XP00, XRD / XCPD )
+#endif
!
! optimization by looking for locations where
! the temperature is negative only !!!
!
GNEGT(:,:,:) = .FALSE.
GNEGT(KIB:KIE,KJB:KJE,KKTB:KKTE) = PT(KIB:KIE,KJB:KJE,KKTB:KKTE)<XTT
+!$acc end kernels
+#ifndef _OPENACC
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+#else
+CALL COUNTJV_DEVICE(GNEGT(:,:,:),I1(:),I2(:),I3(:),INEGT)
+#endif
IF( INEGT >= 1 ) THEN
ALLOCATE(ZRVT(INEGT)) ;
ALLOCATE(ZCIT(INEGT)) ;
ALLOCATE(ZZT(INEGT)) ;
ALLOCATE(ZPRES(INEGT));
- DO JL=1,INEGT
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
- ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ENDDO
ALLOCATE(ZZW(INEGT))
ALLOCATE(ZUSW(INEGT))
ALLOCATE(ZSSI(INEGT))
- ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
- ZZW(:) = MIN(ZPRES(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
- ! Supersaturation over ice
- ZUSW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
- ZUSW(:) = MIN(ZPRES(:)/2.,ZUSW(:)) ! safety limitation
- ZUSW(:) = ( ZUSW(:)/ZZW(:) )*( (ZPRES(:)-ZZW(:))/(ZPRES(:)-ZUSW(:)) ) - 1.0
- ! Supersaturation of saturated water vapor over ice
+!$acc kernels
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT (I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT (I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = PT (I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ENDDO
+#ifndef MNH_BITREP
+ ZZW(1:INEGT) = EXP( XALPI - XBETAI/ZZT(1:INEGT) - XGAMI*ALOG(ZZT(1:INEGT) ) ) ! es_i
+#else
+ ZZW(1:INEGT) = BR_EXP( XALPI - XBETAI/ZZT(1:INEGT) - XGAMI*BR_LOG(ZZT(1:INEGT) ) ) ! es_i
+#endif
+ ZZW(1:INEGT) = MIN(ZPRES(1:INEGT)/2., ZZW(1:INEGT)) ! safety limitation
+ ZSSI(1:INEGT) = ZRVT(1:INEGT)*( ZPRES(1:INEGT)-ZZW(1:INEGT) ) / ( (XMV/XMD) * ZZW(1:INEGT) ) - 1.0
+ ! Supersaturation over ice
+#ifndef MNH_BITREP
+ ZUSW(1:INEGT) = EXP( XALPW - XBETAW/ZZT(1:INEGT) - XGAMW*ALOG(ZZT(1:INEGT) ) ) ! es_w
+#else
+ ZUSW(1:INEGT) = BR_EXP( XALPW - XBETAW/ZZT(1:INEGT) - XGAMW*BR_LOG(ZZT(1:INEGT) ) ) ! es_w
+#endif
+ ZUSW(1:INEGT) = MIN(ZPRES(1:INEGT)/2.,ZUSW(1:INEGT)) ! safety limitation
+ ZUSW(1:INEGT) = ( ZUSW(1:INEGT)/ZZW(1:INEGT) )*( (ZPRES(1:INEGT)-ZZW(1:INEGT))/(ZPRES(1:INEGT)-ZUSW(1:INEGT)) ) - 1.0
+ ! Supersaturation of saturated water vapor over ice
!
!* 3.1 compute the heterogeneous nucleation source: RVHENI
!
!* 3.1.1 compute the cloud ice concentration
!
- ZZW(:) = 0.0
- ZSSI(:) = MIN( ZSSI(:), ZUSW(:) ) ! limitation of SSi according to SSw=0
- WHERE( (ZZT(:)<XTT-5.0) .AND. (ZSSI(:)>0.0) )
- ZZW(:) = XNU20 * EXP( XALPHA2*ZSSI(:)-XBETA2 )
+ ZZW(1:INEGT) = 0.0
+ ZSSI(1:INEGT) = MIN( ZSSI(1:INEGT), ZUSW(1:INEGT) ) ! limitation of SSi according to SSw=0
+ WHERE( (ZZT(1:INEGT)<XTT-5.0) .AND. (ZSSI(1:INEGT)>0.0) )
+#ifndef MNH_BITREP
+ ZZW(1:INEGT) = XNU20 * EXP( XALPHA2*ZSSI(1:INEGT)-XBETA2 )
+#else
+ ZZW(1:INEGT) = XNU20 * BR_EXP( XALPHA2*ZSSI(1:INEGT)-XBETA2 )
+#endif
END WHERE
- WHERE( (ZZT(:)<=XTT-2.0) .AND. (ZZT(:)>=XTT-5.0) .AND. (ZSSI(:)>0.0) )
- ZZW(:) = MAX( XNU20 * EXP( -XBETA2 ),XNU10 * EXP( -XBETA1*(ZZT(:)-XTT) ) * &
- ( ZSSI(:)/ZUSW(:) )**XALPHA1 )
+ WHERE( (ZZT(1:INEGT)<=XTT-2.0) .AND. (ZZT(1:INEGT)>=XTT-5.0) .AND. (ZSSI(1:INEGT)>0.0) )
+#ifndef MNH_BITREP
+ ZZW(1:INEGT) = MAX( XNU20 * EXP( -XBETA2 ),XNU10 * EXP( -XBETA1*(ZZT(1:INEGT)-XTT) ) * &
+ ( ZSSI(1:INEGT)/ZUSW(1:INEGT) )**XALPHA1 )
+#else
+ ZZW(1:INEGT) = MAX( XNU20 * BR_EXP( -XBETA2 ),XNU10 * BR_EXP( -XBETA1*(ZZT(1:INEGT)-XTT) ) * &
+ BR_POW( ZSSI(1:INEGT)/ZUSW(1:INEGT),XALPHA1 ) )
+#endif
END WHERE
- ZZW(:) = ZZW(:) - ZCIT(:)
- IF( MAXVAL(ZZW(:)) > 0.0 ) THEN
+ ZZW(1:INEGT) = ZZW(1:INEGT) - ZCIT(1:INEGT)
+ ZZWMAX = MAXVAL(ZZW(1:INEGT))
+!$acc end kernels
+!$acc kernels
+ IF( ZZWMAX > 0.0 ) THEN
!
!* 3.1.2 update the r_i and r_v mixing ratios
!
- ZZW(:) = MIN( ZZW(:),50.E3 ) ! limitation provisoire a 50 l^-1
+ ZZW(1:INEGT) = MIN( ZZW(1:INEGT),50.E3 ) ! limitation provisoire a 50 l^-1
ZW(:,:,:) = 0.0
+!$acc loop independent
DO JL=1, INEGT
ZW(I1(JL), I2(JL), I3(JL)) = ZZW( JL )
END DO
@@ -162,21 +219,23 @@ IF( INEGT >= 1 ) THEN
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
IF ( KRR == 7 ) THEN
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(PT(:,:,:)-XTT)) &
- /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(PT(:,:,:)-XTT)) &
+ /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))*PEXNREF(:,:,:) )
- ELSE IF( KRR == 6 ) THEN
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(PT(:,:,:)-XTT)) &
- /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ ELSE IF( KRR == 6 ) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(PT(:,:,:)-XTT)) &
+ /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))*PEXNREF(:,:,:) )
END IF
! f(L_s*(RVHENI))
- ZZW(:) = MAX( ZZW(:)+ZCIT(:),ZCIT(:) )
+ ZZW(1:INEGT) = MAX( ZZW(1:INEGT)+ZCIT(1:INEGT),ZCIT(1:INEGT) )
PCIT(:,:,:) = MAX( PCIT(:,:,:), 0.0 )
- DO JL=1, INEGT
+!$acc loop independent
+ DO JL = 1, INEGT
PCIT(I1(JL), I2(JL), I3(JL)) = MAX( ZZW( JL ), PCIT(I1(JL), I2(JL), I3(JL)), 0.0 )
END DO
END IF
+!$acc end kernels
DEALLOCATE(ZSSI)
DEALLOCATE(ZUSW)
DEALLOCATE(ZZW)
diff --git a/src/MNH/rain_ice_sedimentation_split.f90 b/src/MNH/rain_ice_sedimentation_split.f90
index 6dba09363500748d89fd065bb64f6f6e55bb226b..db4078db3021849dfdb9a1df9ad3933326dc9e06 100644
--- a/src/MNH/rain_ice_sedimentation_split.f90
+++ b/src/MNH/rain_ice_sedimentation_split.f90
@@ -35,8 +35,15 @@ use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS, XFSEDC
use mode_mppdb
+#ifndef _OPENACC
use mode_tools, only: Countjv
+#else
+use mode_tools, only: Countjv_device
+#endif
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
use MODI_BUDGET
IMPLICIT NONE
@@ -80,6 +87,19 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
+! IN variables
+!
+!$acc declare present(PDZZ, PRHODREF, PPABST, PTHT, PRHODJ, PRCT, PRRT, PRIT, PRST, PRGT, &
+!$acc & PSEA, PTOWN, PRHT) &
+!
+! INOUT variables
+!
+!$acc & present(PINPRC, PINDEP, PRCS, PRRS, PRIS, PRSS, PRGS, PRHS) &
+!
+! OUT variables
+!
+!$acc & present(PINPRR, PINPRS, PINPRG, PINPRR3D, PINPRH, PFPR)
+!
!* 0.2 declaration of local variables
!
!
@@ -96,19 +116,21 @@ INTEGER :: JK ! Vertical loop index for th
INTEGER :: JN ! Temporal loop index for the rain sedimentation
INTEGER :: JJ ! Loop index for the interpolation
INTEGER :: JL
-INTEGER, DIMENSION(SIZE(PRCS)) :: IC1,IC2,IC3 ! Used to replace the COUNT
-INTEGER, DIMENSION(SIZE(PRCS)) :: IR1,IR2,IR3 ! Used to replace the COUNT
-INTEGER, DIMENSION(SIZE(PRCS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
-INTEGER, DIMENSION(SIZE(PRCS)) :: II1,II2,II3 ! Used to replace the COUNT
-INTEGER, DIMENSION(SIZE(PRCS)) :: IG1,IG2,IG3 ! Used to replace the COUNT
-INTEGER, DIMENSION(SIZE(PRCS)) :: IH1,IH2,IH3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: IC1,IC2,IC3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: IR1,IR2,IR3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: IS1,IS2,IS3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: II1,II2,II3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: IG1,IG2,IG3 ! Used to replace the COUNT
+INTEGER, DIMENSION(:), ALLOCATABLE :: IH1,IH2,IH3 ! Used to replace the COUNT
INTEGER, DIMENSION(:), ALLOCATABLE :: ILISTR,ILISTC,ILISTI,ILISTS,ILISTG,ILISTH
-LOGICAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2)):: GDEP
-LOGICAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
+LOGICAL, DIMENSION(:,:), ALLOCATABLE :: GDEP
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE &
:: GSEDIMR,GSEDIMC, GSEDIMI, GSEDIMS, GSEDIMG, GSEDIMH ! Test where to compute the SED processes
REAL :: ZINVTSTEP
REAL :: ZTSPLITR ! Small time step for rain sedimentation
-REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
+REAL :: ZTMP1, ZTMP2 ! Intermediate variables
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
! XRTMIN = Minimum value for the mixing ratio
! ZRTMIN = Minimum value for the source (tendency)
REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
@@ -132,19 +154,32 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREFC,& ! RHO Dry REFerence
ZWLBDA, & ! Libre parcours moyen
ZZT, & ! Temperature
ZPRES ! Pressure
-REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2)) &
+REAL, DIMENSION(:,:), ALLOCATABLE &
:: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) :: ZCONC3D ! droplet condensation
-REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) :: &
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCONC3D ! droplet condensation
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
ZRAY, & ! Cloud Mean radius
ZLBC, & ! XLBC weighted by sea fraction
ZFSEDC
-REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+REAL, DIMENSION(:,:,:), ALLOCATABLE &
:: ZPRCS,ZPRRS,ZPRSS,ZPRGS,ZPRHS ! Mixing ratios created during the time step
-REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) &
+REAL, DIMENSION(:,:,:), ALLOCATABLE &
:: ZW ! work array
-REAL, DIMENSION(SIZE(PRCS,1),SIZE(PRCS,2),0:SIZE(PRCS,3)+1) &
+REAL, DIMENSION(:,:,:), ALLOCATABLE &
:: ZWSED ! sedimentation fluxes
+!
+! !$acc declare device_resident(IC1, IC2, IC3, IR1, IR2, IR3, IS1, IS2, IS3, II1, II2, II3, IG1, IG2, IG3, IH1, IH2, IH3, &
+!$acc declare create(IC1, IC2, IC3, IR1, IR2, IR3, IS1, IS2, IS3, II1, II2, II3, IG1, IG2, IG3, IH1, IH2, IH3, &
+!$acc & ILISTR, ILISTC, ILISTI, ILISTS, ILISTG, ILISTH, &
+!$acc & GDEP, GSEDIMR, GSEDIMC, GSEDIMI, GSEDIMS, GSEDIMG, GSEDIMH, &
+! !$acc & ZTMP1, ZTMP2, &
+!$acc & ZRTMIN, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZRCT, &
+!$acc & ZRHODREFC, ZRHODREFR, ZRHODREFI, ZRHODREFS, ZRHODREFG, ZRHODREFH, &
+!$acc & ZCC, ZFSEDC1D, ZWLBDC, ZCONC, ZRAY1D, ZWLBDA, ZZT, ZPRES, &
+!$acc & ZCONC_TMP, ZCONC3D, ZRAY, ZLBC, ZFSEDC, &
+!$acc & ZPRCS, ZPRRS, ZPRSS, ZPRGS, ZPRHS, ZW, ZWSED)
+!
+!$acc declare copyin(XFSEDC, XLBC, XLBEXC, XRTMIN)
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
@@ -173,8 +208,47 @@ IF (MPPDB_INITIALIZED) THEN
IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRHS")
END IF
!
+ALLOCATE( IC1(size(PRCS)), IC2(size(PRCS)), IC3(size(PRCS)) )
+ALLOCATE( IR1(size(PRCS)), IR2(size(PRCS)), IR3(size(PRCS)) )
+ALLOCATE( IS1(size(PRCS)), IS2(size(PRCS)), IS3(size(PRCS)) )
+ALLOCATE( II1(size(PRCS)), II2(size(PRCS)), II3(size(PRCS)) )
+ALLOCATE( IG1(size(PRCS)), IG2(size(PRCS)), IG3(size(PRCS)) )
+ALLOCATE( IH1(size(PRCS)), IH2(size(PRCS)), IH3(size(PRCS)) )
+ALLOCATE( GDEP(SIZE(PRCS,1),SIZE(PRCS,2)) )
+ALLOCATE( GSEDIMR(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( GSEDIMC(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( GSEDIMI(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( GSEDIMS(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( GSEDIMG(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( GSEDIMH(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZRTMIN(SIZE(XRTMIN)) )
+ALLOCATE( ZCONC_TMP(SIZE(PRCS,1),SIZE(PRCS,2)) )
+ALLOCATE( ZCONC3D(SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZRAY (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZLBC (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZFSEDC (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZPRCS (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZPRRS (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZPRSS (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZPRGS (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZPRHS (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZW (SIZE(PRCS,1),SIZE(PRCS,2),SIZE(PRCS,3)) )
+ALLOCATE( ZWSED (SIZE(PRCS,1),SIZE(PRCS,2),0:SIZE(PRCS,3)+1) )
+!
+IF ( PRESENT( PFPR ) ) THEN
+ GPRESENT_PFPR = .TRUE.
+ELSE
+ GPRESENT_PFPR = .FALSE.
+END IF
+IF ( PRESENT( PSEA ) ) THEN
+ GPRESENT_PSEA = .TRUE.
+ELSE
+ GPRESENT_PSEA = .FALSE.
+END IF
+!
! O. Initialization of for sedimentation
!
+!$acc kernels
ZINVTSTEP=1./PTSTEP
ZTSPLITR= PTSTEP / REAL(KSPLITR)
!
@@ -185,17 +259,20 @@ PINPRR3D (:,:,:) = 0.
PINPRS (:,:) = 0.
PINPRG (:,:) = 0.
IF ( KRR == 7 ) PINPRH (:,:) = 0.
-IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
+IF ( GPRESENT_PFPR ) PFPR(:,:,:,:) = 0.
!
!* 1. Parameters for cloud sedimentation
!
IF (OSEDIC) THEN
+ ZTMP1 = 0.5*GAMMA(XNUC+ 1.0/XALPHAC )/(GAMMA(XNUC ))
+ ZTMP2 = 0.5*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2))
+
ZRAY(:,:,:) = 0.
ZLBC(:,:,:) = XLBC(1)
ZFSEDC(:,:,:) = XFSEDC(1)
ZCONC3D(:,:,:)= XCONC_LAND
ZCONC_TMP(:,:)= XCONC_LAND
- IF (PRESENT(PSEA)) THEN
+ IF ( GPRESENT_PSEA ) THEN
ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
DO JK=KKTB,KKTE
@@ -203,12 +280,11 @@ IF (PRESENT(PFPR)) PFPR(:,:,:,:) = 0.
ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
+ ZRAY(:,:,JK) = (1.-PSEA(:,:)) * ZTMP1 + PSEA(:,:) * ZTMP2
END DO
ELSE
ZCONC3D(:,:,:) = XCONC_LAND
- ZRAY(:,:,:) = 0.5*(GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)))
+ ZRAY (:,:,:) = ZTMP1
END IF
ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
@@ -243,10 +319,6 @@ IF (OSEDIC) THEN
ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
PRCS(:,:,:) = PRCT(:,:,:)* ZINVTSTEP
END IF
-ZPRRS(:,:,:) = 0.0
-ZPRSS(:,:,:) = 0.0
-ZPRGS(:,:,:) = 0.0
-IF ( KRR == 7 ) ZPRHS(:,:,:) = 0.0
!
ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
@@ -256,11 +328,13 @@ PRRS(:,:,:) = PRRT(:,:,:)* ZINVTSTEP
PRSS(:,:,:) = PRST(:,:,:)* ZINVTSTEP
PRGS(:,:,:) = PRGT(:,:,:)* ZINVTSTEP
IF ( KRR == 7 ) PRHS(:,:,:) = PRHT(:,:,:)* ZINVTSTEP
+!$acc end kernels
!
! PRiS = Source of the previous time step + source created during the subtime
! step
!
DO JN = 1 , KSPLITR
+!$acc kernels
IF( JN==1 ) THEN
IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)/KSPLITR
PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)/KSPLITR
@@ -290,19 +364,31 @@ DO JN = 1 , KSPLITR
PRGS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(6)
IF ( KRR == 7 ) GSEDIMH(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
PRHS(KIB:KIE,KJB:KJE,KKTB:KKTE)>ZRTMIN(7)
+!$acc end kernels
!
- IF (OSEDIC) ISEDIMC = COUNTJV( GSEDIMC(:,:,:),IC1(:),IC2(:),IC3(:))
+#ifndef _OPENACC
+IF (OSEDIC) ISEDIMC = COUNTJV( GSEDIMC(:,:,:),IC1(:),IC2(:),IC3(:))
ISEDIMR = COUNTJV( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:))
ISEDIMI = COUNTJV( GSEDIMI(:,:,:),II1(:),II2(:),II3(:))
ISEDIMS = COUNTJV( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:))
ISEDIMG = COUNTJV( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:))
IF ( KRR == 7 ) ISEDIMH = COUNTJV( GSEDIMH(:,:,:),IH1(:),IH2(:),IH3(:))
+#else
+ IF (OSEDIC) CALL COUNTJV_DEVICE(GSEDIMC,IC1,IC2,IC3,ISEDIMC)
+ CALL COUNTJV_DEVICE(GSEDIMR,IR1,IR2,IR3,ISEDIMR)
+ CALL COUNTJV_DEVICE(GSEDIMI,II1,II2,II3,ISEDIMI)
+ CALL COUNTJV_DEVICE(GSEDIMS,IS1,IS2,IS3,ISEDIMS)
+ CALL COUNTJV_DEVICE(GSEDIMG,IG1,IG2,IG3,ISEDIMG)
+ IF ( KRR == 7 ) CALL COUNTJV_DEVICE(GSEDIMH,IH1,IH2,IH3,ISEDIMH)
+#endif
!
!* 2.1 for cloud
!
- IF (OSEDIC) THEN
+IF (OSEDIC) THEN
+!$acc kernels
ZWSED(:,:,:) = 0.
IF( JN==1 ) PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+!$acc end kernels
IF( ISEDIMC >= 1 ) THEN
IF ( ISEDIMC .GT. ILENALLOCC ) THEN
IF ( ILENALLOCC .GT. 0 ) THEN
@@ -315,8 +401,23 @@ DO JN = 1 , KSPLITR
ZWLBDC(ILENALLOCC), ZCONC(ILENALLOCC), ZRCT(ILENALLOCC), ZZT(ILENALLOCC), &
ZPRES(ILENALLOCC), ZRAY1D(ILENALLOCC), ZFSEDC1D(ILENALLOCC), &
ZWLBDA(ILENALLOCC), ZCC(ILENALLOCC) )
+!$acc kernels
+ZRCS (:) = 0.
+ZRHODREFC(:) = 0.
+ILISTC (:) = 0
+ZWLBDC (:) = 0.
+ZCONC (:) = 0.
+ZRCT (:) = 0.
+ZZT (:) = 0.
+ZPRES (:) = 0.
+ZRAY1D (:) = 0.
+ZFSEDC1D (:) = 0.
+ZWLBDA (:) = 0.
+ZCC (:) = 0.
+!$acc end kernels
END IF
!
+!$acc kernels
DO JL=1,ISEDIMC
ZRCS(JL) = PRCS(IC1(JL),IC2(JL),IC3(JL))
ZRHODREFC(JL) = PRHODREF(IC1(JL),IC2(JL),IC3(JL))
@@ -339,21 +440,42 @@ DO JN = 1 , KSPLITR
DO JJ = 1, ILISTLENC
JL = ILISTC(JJ)
IF (ZRCS(JL) .GT. ZRTMIN(2) .AND. ZRCT(JL) .GT. XRTMIN(2)) THEN
- ZWLBDC(JL) = ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL))
- ZWLBDC(JL) = ZWLBDC(JL)**XLBEXC
+!Problems with PGI (18.10). OK if 2 lines are merged!
+! ZWLBDC(JL) = ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL))
+! #ifndef MNH_BITREP
+! ZWLBDC(JL) = ZWLBDC(JL)**XLBEXC
+! #else
+! ZWLBDC(JL) = BR_POW(ZWLBDC(JL),XLBEXC)
+! #endif
+#ifndef MNH_BITREP
+ ZWLBDC(JL) = (ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL)))**XLBEXC
+#else
+ ZWLBDC(JL) = BR_POW(ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL)),XLBEXC)
+#endif
ZRAY1D(JL) = ZRAY1D(JL) / ZWLBDC(JL) !! ZRAY : mean diameter=M(1)/2
+#ifndef MNH_BITREP
ZZT(JL) = ZZT(JL) * (ZPRES(JL)/XP00)**(XRD/XCPD)
+#else
+ ZZT(JL) = ZZT(JL) * BR_POW(ZPRES(JL)/XP00,XRD/XCPD)
+#endif
ZWLBDA(JL) = 6.6E-8*(101325./ZPRES(JL))*(ZZT(JL)/293.15)
ZCC(JL) = XCC*(1.+1.26*ZWLBDA(JL)/ZRAY1D(JL)) !! XCC modified for cloud
+#ifndef MNH_BITREP
ZWSED (IC1(JL),IC2(JL),IC3(JL))= ZRHODREFC(JL)**(-XCEXVT +1 ) * &
ZWLBDC(JL)**(-XDC)*ZCC(JL)*ZFSEDC1D(JL) * ZRCS(JL)
+#else
+ ZWSED (IC1(JL),IC2(JL),IC3(JL))= BR_POW(ZRHODREFC(JL),-XCEXVT +1 ) * &
+ BR_POW(ZWLBDC(JL),-XDC)*ZCC(JL)*ZFSEDC1D(JL) * ZRCS(JL)
+#endif
END IF
END DO
+!$acc end kernels
END IF
+!$acc kernels
DO JK = KKTB , KKTE
PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
END DO
- IF (PRESENT(PFPR)) THEN
+ IF ( GPRESENT_PFPR ) THEN
DO JK = KKTB , KKTE
PFPR(:,:,JK,2)=ZWSED(:,:,JK)
ENDDO
@@ -362,12 +484,15 @@ DO JN = 1 , KSPLITR
IF( JN==KSPLITR ) THEN
PRCS(:,:,:) = PRCS(:,:,:) * ZINVTSTEP
END IF
+!$acc end kernels
END IF
!
!* 2.2 for rain
!
+!$acc kernels
IF( JN==1 ) PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
ZWSED(:,:,:) = 0.
+!$acc end kernels
IF( ISEDIMR >= 1 ) THEN
IF ( ISEDIMR .GT. ILENALLOCR ) THEN
IF ( ILENALLOCR .GT. 0 ) THEN
@@ -378,6 +503,7 @@ DO JN = 1 , KSPLITR
ALLOCATE(ZRRS(ILENALLOCR), ZRHODREFR(ILENALLOCR), ILISTR(ILENALLOCR))
END IF
!
+!$acc kernels
DO JL=1,ISEDIMR
ZRRS(JL) = PRRS(IR1(JL),IR2(JL),IR3(JL))
ZRHODREFR(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
@@ -392,14 +518,21 @@ DO JN = 1 , KSPLITR
END DO
DO JJ = 1, ILISTLENR
JL = ILISTR(JJ)
+#ifndef MNH_BITREP
ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * ZRRS(JL)**XEXSEDR * &
ZRHODREFR(JL)**(XEXSEDR-XCEXVT)
+#else
+ ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * BR_POW(ZRRS(JL),XEXSEDR) * &
+ BR_POW(ZRHODREFR(JL),XEXSEDR-XCEXVT)
+#endif
END DO
+!$acc end kernels
END IF
+!$acc kernels
DO JK = KKTB , KKTE
PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
END DO
- IF (PRESENT(PFPR)) THEN
+ IF ( GPRESENT_PFPR ) THEN
DO JK = KKTB , KKTE
PFPR(:,:,JK,3)=ZWSED(:,:,JK)
ENDDO
@@ -409,11 +542,14 @@ DO JN = 1 , KSPLITR
IF( JN==KSPLITR ) THEN
PRRS(:,:,:) = PRRS(:,:,:) * ZINVTSTEP
END IF
+!$acc end kernels
!
!* 2.3 for pristine ice
!
+!$acc kernels
IF( JN==1 ) PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
ZWSED(:,:,:) = 0.
+!$acc end kernels
IF( ISEDIMI >= 1 ) THEN
IF ( ISEDIMI .GT. ILENALLOCI ) THEN
IF ( ILENALLOCI .GT. 0 ) THEN
@@ -424,6 +560,7 @@ DO JN = 1 , KSPLITR
ALLOCATE(ZRIS(ILENALLOCI), ZRHODREFI(ILENALLOCI), ILISTI(ILENALLOCI))
END IF
!
+!$acc kernels
DO JL=1,ISEDIMI
ZRIS(JL) = PRIS(II1(JL),II2(JL),II3(JL))
ZRHODREFI(JL) = PRHODREF(II1(JL),II2(JL),II3(JL))
@@ -438,16 +575,25 @@ DO JN = 1 , KSPLITR
END DO
DO JJ = 1, ILISTLENI
JL = ILISTI(JJ)
+#ifndef MNH_BITREP
ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRIS(JL) * &
- ZRHODREFI(JL)**(1.0-XCEXVT) * & ! McF&H
- MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ ZRHODREFI(JL)**(1.0-XCEXVT) * & ! McF&H
+ MAX( 0.05E6,-0.15319E6-0.021454E6* &
ALOG(ZRHODREFI(JL)*ZRIS(JL)) )**XEXCSEDI
+#else
+ ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRIS(JL) * &
+ BR_POW(ZRHODREFI(JL),1.0-XCEXVT) * & ! McF&H
+ BR_POW( MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ BR_LOG(ZRHODREFI(JL)*ZRIS(JL)) ), XEXCSEDI)
+#endif
END DO
+!$acc end kernels
END IF
+!$acc kernels
DO JK = KKTB , KKTE
PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
END DO
- IF (PRESENT(PFPR)) THEN
+ IF ( GPRESENT_PFPR ) THEN
DO JK = KKTB , KKTE
PFPR(:,:,JK,4)=ZWSED(:,:,JK)
ENDDO
@@ -455,11 +601,14 @@ DO JN = 1 , KSPLITR
IF( JN==KSPLITR ) THEN
PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
END IF
+!$acc end kernels
!
!* 2.4 for aggregates/snow
!
+!$acc kernels
IF( JN==1 ) PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
ZWSED(:,:,:) = 0.
+!$acc end kernels
IF( ISEDIMS >= 1 ) THEN
IF ( ISEDIMS .GT. ILENALLOCS ) THEN
IF ( ILENALLOCS .GT. 0 ) THEN
@@ -470,6 +619,7 @@ DO JN = 1 , KSPLITR
ALLOCATE(ZRSS(ILENALLOCS), ZRHODREFS(ILENALLOCS), ILISTS(ILENALLOCS))
END IF
!
+!$acc kernels
DO JL=1,ISEDIMS
ZRSS(JL) = PRSS(IS1(JL),IS2(JL),IS3(JL))
ZRHODREFS(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
@@ -484,14 +634,21 @@ DO JN = 1 , KSPLITR
END DO
DO JJ = 1, ILISTLENS
JL = ILISTS(JJ)
+#ifndef MNH_BITREP
ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * ZRSS(JL)**XEXSEDS * &
ZRHODREFS(JL)**(XEXSEDS-XCEXVT)
+#else
+ ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * BR_POW(ZRSS(JL),XEXSEDS) * &
+ BR_POW(ZRHODREFS(JL),XEXSEDS-XCEXVT)
+#endif
END DO
+!$acc end kernels
END IF
+!$acc kernels
DO JK = KKTB , KKTE
PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
END DO
- IF (PRESENT(PFPR)) THEN
+ IF ( GPRESENT_PFPR ) THEN
DO JK = KKTB , KKTE
PFPR(:,:,JK,5)=ZWSED(:,:,JK)
ENDDO
@@ -500,11 +657,14 @@ DO JN = 1 , KSPLITR
IF( JN==KSPLITR ) THEN
PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
END IF
+!$acc end kernels
!
!* 2.5 for graupeln
!
+!$acc kernels
ZWSED(:,:,:) = 0.
IF( JN==1 ) PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+!$acc end kernels
IF( ISEDIMG >= 1 ) THEN
IF ( ISEDIMG .GT. ILENALLOCG ) THEN
IF ( ILENALLOCG .GT. 0 ) THEN
@@ -515,6 +675,7 @@ DO JN = 1 , KSPLITR
ALLOCATE(ZRGS(ILENALLOCG), ZRHODREFG(ILENALLOCG), ILISTG(ILENALLOCG))
END IF
!
+!$acc kernels
DO JL=1,ISEDIMG
ZRGS(JL) = PRGS(IG1(JL),IG2(JL),IG3(JL))
ZRHODREFG(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
@@ -529,14 +690,21 @@ DO JN = 1 , KSPLITR
END DO
DO JJ = 1, ILISTLENG
JL = ILISTG(JJ)
+#ifndef MNH_BITREP
ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * ZRGS(JL)**XEXSEDG * &
ZRHODREFG(JL)**(XEXSEDG-XCEXVT)
+#else
+ ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * BR_POW(ZRGS(JL),XEXSEDG) * &
+ BR_POW(ZRHODREFG(JL),XEXSEDG-XCEXVT)
+#endif
END DO
+!$acc end kernels
END IF
+!$acc kernels
DO JK = KKTB , KKTE
PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
END DO
- IF (PRESENT(PFPR)) THEN
+ IF ( GPRESENT_PFPR ) THEN
DO JK = KKTB , KKTE
PFPR(:,:,JK,6)=ZWSED(:,:,JK)
ENDDO
@@ -545,12 +713,15 @@ END IF
IF( JN==KSPLITR ) THEN
PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
END IF
+!$acc end kernels
!
!* 2.6 for hail
!
IF ( KRR == 7 ) THEN
+!$acc kernels
IF( JN==1 ) PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
ZWSED(:,:,:) = 0.
+!$acc end kernels
IF( ISEDIMH >= 1 ) THEN
IF ( ISEDIMH .GT. ILENALLOCH ) THEN
IF ( ILENALLOCH .GT. 0 ) THEN
@@ -561,6 +732,7 @@ END IF
ALLOCATE(ZRHS(ILENALLOCH), ZRHODREFH(ILENALLOCH), ILISTH(ILENALLOCH))
END IF
!
+!$acc kernels
DO JL=1,ISEDIMH
ZRHS(JL) = PRHS(IH1(JL),IH2(JL),IH3(JL))
ZRHODREFH(JL) = PRHODREF(IH1(JL),IH2(JL),IH3(JL))
@@ -575,14 +747,21 @@ END IF
END DO
DO JJ = 1, ILISTLENH
JL = ILISTH(JJ)
+#ifndef MNH_BITREP
ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * ZRHS(JL)**XEXSEDH * &
ZRHODREFH(JL)**(XEXSEDH-XCEXVT)
+#else
+ ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * BR_POW(ZRHS(JL),XEXSEDH) * &
+ BR_POW(ZRHODREFH(JL),XEXSEDH-XCEXVT)
+#endif
END DO
+!$acc end kernels
END IF
+!$acc kernels
DO JK = KKTB , KKTE
PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
END DO
- IF (PRESENT(PFPR)) THEN
+ IF ( GPRESENT_PFPR ) THEN
DO JK = KKTB , KKTE
PFPR(:,:,JK,7)=ZWSED(:,:,JK)
ENDDO
@@ -591,6 +770,7 @@ END IF
IF( JN==KSPLITR ) THEN
PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
END IF
+!$acc end kernels
END IF
!
END DO
@@ -607,19 +787,36 @@ IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH)
!
!* 2.3 budget storage
!
-IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG')
-IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH')
+IF (LBUDGET_RC .AND. OSEDIC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
+END IF
+IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
+END IF
+IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI')
+END IF
+IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS')
+END IF
+IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG')
+END IF
+IF ( KRR == 7 .AND. LBUDGET_RH) THEN
+!$acc update self(PRHS)
+ CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH')
+END IF
!
!
!
!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
!
+!$acc kernels
IF (ODEPOSC) THEN
GDEP(:,:) = .FALSE.
GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
@@ -629,13 +826,15 @@ IF (ODEPOSC) THEN
PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
END WHERE
END IF
+!$acc end kernels
!
!* 2.5 budget storage
!
-IF ( LBUDGET_RC .AND. ODEPOSC ) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
+IF ( LBUDGET_RC .AND. ODEPOSC ) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
+END IF
!
-
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PINPRC,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRC")
diff --git a/src/MNH/rain_ice_sedimentation_stat.f90 b/src/MNH/rain_ice_sedimentation_stat.f90
index 3156ab84cf81a4df23261990ae54482257b8b646..4c1b4375cc4d13ac2cd7a9d98fbe8da76e0a20b1 100644
--- a/src/MNH/rain_ice_sedimentation_stat.f90
+++ b/src/MNH/rain_ice_sedimentation_stat.f90
@@ -34,6 +34,7 @@ use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
use MODD_RAIN_ICE_DESCR, only: XALPHAC, XALPHAC2, XCC, XCEXVT, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
XDC, XLBC, XLBEXC, XNUC, XNUC2, XRTMIN
+use mode_msg
use mode_tools, only: Countjv
use MODI_BUDGET
@@ -106,6 +107,9 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
:: ZWSEDW2 ! sedimentation speed
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_SEDIMENTATION_STAT','OPENACC: not yet implemented')
+#endif
!
ZINVTSTEP=1./PTSTEP
!
diff --git a/src/MNH/rain_ice_slow.f90 b/src/MNH/rain_ice_slow.f90
index c004fe3867d98d260cc117b5bf8e1145f2655179..c8248fc0d8199cd6e5b52510c4b694625974af1c 100644
--- a/src/MNH/rain_ice_slow.f90
+++ b/src/MNH/rain_ice_slow.f90
@@ -34,6 +34,9 @@ use MODD_RAIN_ICE_PARAM, only: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA
!
use mode_mppdb
!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
use MODI_BUDGET
!
IMPLICIT NONE
@@ -71,10 +74,27 @@ REAL, DIMENSION(:), intent(OUT) :: PDV ! Diffusivity of water vap
REAL, DIMENSION(:), intent(OUT) :: PLBDAS ! Slope parameter of the aggregate distribution
REAL, DIMENSION(:), intent(OUT) :: PLBDAG ! Slope parameter of the graupel distribution
!
+! IN variables
+!
+!$acc declare present(OMICRO, PRHODREF, PRCT, PRRT, PRIT, PRST, PRGT, &
+!$acc & PRHODJ, PZT, PPRES, PLSFACT, PLVFACT, PSSI, &
+!$acc & PRHODJ3D, PTHS3D, PRVS3D) &
+!
+! INOUT variables
+!
+!$acc & present(PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PTHS) &
+!
+! OUT variables
+!
+!$acc & present(PAI, PCJ, PKA, PDV, PLBDAS, PLBDAG)
+!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
-REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
+!
+!$acc declare device_resident(GWORK, ZZW, ZCRIAUTI)
!
!-------------------------------------------------------------------------------
!
@@ -105,61 +125,92 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_SLOW beg:PTHS")
END IF
!
+ALLOCATE( GWORK (size(PRHODREF)) )
+ALLOCATE( ZZW (size(PRHODREF)) )
+ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
+!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
+!$acc kernels
ZZW(:) = 0.0
- WHERE( (PZT(:)<XTT-35.0) .AND. (PRCT(:)>XRTMIN(2)) .AND. (PRCS(:)>0.) )
+ GWORK(:) = PZT(:)<XTT-35.0 .AND. PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.
+ WHERE( GWORK(:) )
ZZW(:) = MIN( PRCS(:),XHON*PRHODREF(:)*PRCT(:) &
+#ifndef MNH_BITREP
*EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(PZT(:)-XTT)-XBETA3) ) )
- ! *EXP( XALPHA3*(PZT(:)-XTT)-XBETA3 ) )
+#else
+ *BR_EXP(MIN(XMNH_HUGE_12_LOG, XALPHA3*(PZT(:)-XTT)-XBETA3) ) )
+#endif
PRIS(:) = PRIS(:) + ZZW(:)
PRCS(:) = PRCS(:) - ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCHONI))
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'HON_BU_RRI')
+!$acc end kernels
+!
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'HON_BU_RTH')
+ END IF
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'HON_BU_RRC')
+ END IF
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'HON_BU_RRI')
+ END IF
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
+!$acc kernels
ZZW(:) = 0.0
- WHERE( (PZT(:)<XTT-35.0) .AND. (PRRT(:)>XRTMIN(3)) .AND. (PRRS(:)>0.) )
+ GWORK(:) = PZT(:)<XTT-35.0 .AND. PRRT(:)>XRTMIN(3) .AND. PRRS(:)>0.
+ WHERE( GWORK(:) )
ZZW(:) = MIN( PRRS(:),PRRT(:)* PINVTSTEP )
PRGS(:) = PRGS(:) + ZZW(:)
PRRS(:) = PRRS(:) - ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG))
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'SFR_BU_RRG')
+!$acc end kernels
+!
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'SFR_BU_RTH')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'SFR_BU_RRR')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'SFR_BU_RRG')
+ END IF
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
!
+!$acc kernels
PKA(:) = 2.38E-2 + 0.0071E-2 * ( PZT(:) - XTT ) ! k_a
+#ifndef MNH_BITREP
PDV(:) = 0.211E-4 * (PZT(:)/XTT)**1.94 * (XP00/PPRES(:)) ! D_v
+#else
+ PDV(:) = 0.211E-4 * BR_POW(PZT(:)/XTT,1.94) * (XP00/PPRES(:)) ! D_v
+#endif
!
!* 3.4.1 compute the thermodynamical function A_i(T,P)
!* and the c^prime_j (in the ventilation factor)
!
+#ifndef MNH_BITREP
PAI(:) = EXP( XALPI - XBETAI/PZT(:) - XGAMI*ALOG(PZT(:) ) ) ! es_i
PAI(:) = ( XLSTT + (XCPV-XCI)*(PZT(:)-XTT) )**2 / (PKA(:)*XRV*PZT(:)**2) &
+ ( XRV*PZT(:) ) / (PDV(:)*PAI(:))
PCJ(:) = XSCFAC * PRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(PZT(:)-XTT) )
+#else
+ PAI(:) = BR_EXP( XALPI - XBETAI/PZT(:) - XGAMI*BR_LOG(PZT(:) ) ) ! es_i
+ PAI(:) = BR_P2( XLSTT + (XCPV-XCI)*(PZT(:)-XTT) ) / (PKA(:)*XRV*BR_P2(PZT(:))) &
+ + ( XRV*PZT(:) ) / (PDV(:)*PAI(:))
+ PCJ(:) = XSCFAC * BR_POW(PRHODREF(:),0.3) / BR_POW( 1.718E-5+0.0049E-5*(PZT(:)-XTT) , 0.5)
+#endif
!
!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
!
@@ -174,91 +225,152 @@ END IF
!
!* 3.4.3 compute the deposition on r_s: RVDEPS
!
- WHERE ( PRST(:)>0.0 )
+ GWORK(:) = PRST(:)>0.0
+ WHERE ( GWORK(:) )
+#ifndef MNH_BITREP
PLBDAS(:) = MIN( XLBDAS_MAX, &
XLBS*( PRHODREF(:)*MAX( PRST(:),XRTMIN(5) ) )**XLBEXS )
+#else
+ PLBDAS(:) = MIN( XLBDAS_MAX, &
+ XLBS*BR_POW( PRHODREF(:)*MAX( PRST(:),XRTMIN(5) ),XLBEXS ) )
+#endif
+ ELSEWHERE
+ PLBDAS(:) = 0.
END WHERE
ZZW(:) = 0.0
- WHERE ( (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0) )
+ GWORK(:) = (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0)
+ WHERE ( GWORK(:) )
+#ifndef MNH_BITREP
ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
+#else
+ ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+ ( X0DEPS*BR_POW(PLBDAS(:),XEX0DEPS) + X1DEPS*PCJ(:)*BR_POW(PLBDAS(:),XEX1DEPS) )
+#endif
ZZW(:) = MIN( PRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
- MIN( PRSS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
PRSS(:) = PRSS(:) + ZZW(:)
PRVS(:) = PRVS(:) - ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
- 6,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'DEPS_BU_RRS')
+!$acc end kernels
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'DEPS_BU_RTH')
+ END IF
+ IF (LBUDGET_RV) THEN
+!$acc update self(PRVS)
+ CALL BUDGET (UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:),6,'DEPS_BU_RRV')
+ END IF
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'DEPS_BU_RRS')
+ END IF
!
!* 3.4.4 compute the aggregation on r_s: RIAGGS
!
+!$acc kernels
ZZW(:) = 0.0
- WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. (PRIS(:)>0.0) )
+ GWORK(:) = PRIT(:)>XRTMIN(4) .AND. PRST(:)>XRTMIN(5) .AND. PRIS(:)>0.0
+ WHERE ( GWORK(:) )
+#ifndef MNH_BITREP
ZZW(:) = MIN( PRIS(:),XFIAGGS * EXP( XCOLEXIS*(PZT(:)-XTT) ) &
* PRIT(:) &
* PLBDAS(:)**XEXIAGGS &
* PRHODREF(:)**(-XCEXVT) )
+#else
+ ZZW(:) = MIN( PRIS(:),XFIAGGS * BR_EXP( XCOLEXIS*(PZT(:)-XTT) ) &
+ * PRIT(:) &
+ * BR_POW(PLBDAS(:),XEXIAGGS) &
+ * BR_POW(PRHODREF(:),-XCEXVT) )
+#endif
PRSS(:) = PRSS(:) + ZZW(:)
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'AGGS_BU_RRS')
+!$acc end kernels
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'AGGS_BU_RRI')
+ END IF
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'AGGS_BU_RRS')
+ END IF
!
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
-! ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PZT(:)-XTT)-3.5))
+!$acc kernels
+#ifndef MNH_BITREP
ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PZT(:)-XTT)+XBCRIAUTI))
+#else
+ ZCRIAUTI(:)=MIN(XCRIAUTI, BR_POW(10.,XACRIAUTI*(PZT(:)-XTT)+XBCRIAUTI) )
+#endif
ZZW(:) = 0.0
- WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRIS(:)>0.0) )
+ GWORK(:) = PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0
+ WHERE ( GWORK(:) )
+#ifndef MNH_BITREP
ZZW(:) = MIN( PRIS(:),XTIMAUTI * EXP( XTEXAUTI*(PZT(:)-XTT) ) &
* MAX( PRIT(:)-ZCRIAUTI(:),0.0 ) )
+#else
+ ZZW(:) = MIN( PRIS(:),XTIMAUTI * BR_EXP( XTEXAUTI*(PZT(:)-XTT) ) &
+ * MAX( PRIT(:)-ZCRIAUTI(:),0.0 ) )
+#endif
PRSS(:) = PRSS(:) + ZZW(:)
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 9,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 10,'AUTS_BU_RRS')
+!$acc end kernels
+ IF (LBUDGET_RI) THEN
+!$acc update self(PRIS)
+ CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'AUTS_BU_RRI')
+ END IF
+ IF (LBUDGET_RS) THEN
+!$acc update self(PRSS)
+ CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'AUTS_BU_RRS')
+ END IF
!
!* 3.4.6 compute the deposition on r_g: RVDEPG
!
!
- WHERE ( PRGT(:)>0.0 )
+!$acc kernels
+ GWORK(:) = PRGT(:)>0.0
+ WHERE ( GWORK(:) )
+#ifndef MNH_BITREP
PLBDAG(:) = XLBG*( PRHODREF(:)*MAX( PRGT(:),XRTMIN(6) ) )**XLBEXG
+#else
+ PLBDAG(:) = XLBG*BR_POW( PRHODREF(:)*MAX( PRGT(:),XRTMIN(6) ), XLBEXG)
+#endif
+ ELSEWHERE
+ PLBDAG(:) = 0.
END WHERE
ZZW(:) = 0.0
- WHERE ( (PRGT(:)>XRTMIN(6)) .AND. (PRGS(:)>0.0) )
+ GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0
+ WHERE ( GWORK(:) )
+#ifndef MNH_BITREP
ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
+#else
+ ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
+ ( X0DEPG*BR_POW(PLBDAG(:),XEX0DEPG) + X1DEPG*PCJ(:)*BR_POW(PLBDAG(:),XEX1DEPG) )
+#endif
ZZW(:) = MIN( PRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
- MIN( PRGS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
PRGS(:) = PRGS(:) + ZZW(:)
PRVS(:) = PRVS(:) - ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
END WHERE
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
- 6,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 11,'DEPG_BU_RRG')
+!$acc end kernels
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'DEPG_BU_RTH')
+ END IF
+ IF (LBUDGET_RV) THEN
+!$acc update self(PRVS)
+ CALL BUDGET (UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:),6,'DEPG_BU_RRV')
+ END IF
+ IF (LBUDGET_RG) THEN
+!$acc update self(PRGS)
+ CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'DEPG_BU_RRG')
+ END IF
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/rain_ice_warm.f90 b/src/MNH/rain_ice_warm.f90
index 7c958b685f25f8ec7ce8176ed35adfc1fb31e889..be4cab61ee2b52a40898a1ce976c8bd4fb690216 100644
--- a/src/MNH/rain_ice_warm.f90
+++ b/src/MNH/rain_ice_warm.f90
@@ -34,6 +34,9 @@ use MODD_RAIN_ICE_PARAM, only: X0EVAR, X1EVAR, XCRIAUTC, XEX0EVAR, XEX1EVAR, XEX
use mode_mppdb
use MODE_MSG
!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
use MODI_BUDGET
!
IMPLICIT NONE
@@ -78,13 +81,32 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:), INTENT(INOUT) :: PUSW ! Undersaturation over water
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!
+! IN variables
+!
+!$acc declare present(OMICRO, K1, K2, K3, PRHODREF, PRVT, PRCT, PRRT, &
+!$acc & PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+!$acc & PRHODJ, PPRES, PZT, PLBDAR, PLBDAR_RF, PLVFACT, &
+!$acc & PCJ, PKA, PDV, PRF, PCF, PTHT,PTHLT, &
+!$acc & PRHODJ3D, PTHS3D, PRVS3D) &
+!
+! INOUT variables
+!
+!$acc & present(PRVS, PRCS, PRRS, PTHS, PUSW, PEVAP3D)
+!
+! OUT variables
+!
+!NONE
+!
!* 0.2 declaration of local variables
!
-INTEGER :: JL
-REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
-REAL, DIMENSION(size(PRHODREF)) :: ZZW2 ! Work array
-REAL, DIMENSION(size(PRHODREF)) :: ZZW3 ! Work array
-REAL, DIMENSION(size(PRHODREF)) :: ZZW4 ! Work array
+INTEGER :: JL
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW2 ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW3 ! Work array
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW4 ! Work array
+!
+!$acc declare device_resident(GWORK, ZZW, ZZW2, ZZW3, ZZW4)
!
!-------------------------------------------------------------------------------
!
@@ -124,36 +146,60 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE_WARM beg:PEVAP3D")
END IF
!
+ALLOCATE( GWORK(size(PRHODREF)) )
+ALLOCATE( ZZW (size(PRHODREF)) )
+ALLOCATE( ZZW2 (size(PRHODREF)) )
+ALLOCATE( ZZW3 (size(PRHODREF)) )
+ALLOCATE( ZZW4 (size(PRHODREF)) )
+!
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
-
- WHERE( PRCS(:)>0.0 .AND. PHLC_HCF(:).GT.0.0 )
+!$acc kernels
+ GWORK(:) = PRCS(:)>0.0 .AND. PHLC_HCF(:)>0.0
+ WHERE( GWORK(:) )
ZZW(:) = XTIMAUTC*MAX( PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:),0.0)
ZZW(:) = MIN( PRCS(:),PHLC_HCF(:)*ZZW(:))
PRCS(:) = PRCS(:) - ZZW(:)
PRRS(:) = PRRS(:) + ZZW(:)
END WHERE
+!$acc end kernels
!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'AUTO_BU_RRR')
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'AUTO_BU_RRC')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'AUTO_BU_RRR')
+ END IF
!
!* 4.3 compute the accretion of r_c for r_r production: RCACCR
!
IF (CSUBG_RC_RR_ACCR=='NONE') THEN
+!$acc kernels
!CLoud water and rain are diluted over the grid box
- WHERE( PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 )
- ZZW(:) = MIN( PRCS(:), XFCACCR * PRCT(:) &
- * PLBDAR(:)**XEXCACCR &
+ GWORK(:) = PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0
+ WHERE( GWORK(:) )
+#ifndef MNH_BITREP
+ ZZW(:) = MIN( PRCS(:), XFCACCR * PRCT(:) &
+ * PLBDAR(:)**XEXCACCR &
* PRHODREF(:)**(-XCEXVT) )
+#else
+ ZZW(:) = MIN( PRCS(:), XFCACCR * PRCT(:) &
+ * BR_POW(PLBDAR(:),XEXCACCR) &
+ * BR_POW(PRHODREF(:),-XCEXVT) )
+
+#endif
PRCS(:) = PRCS(:) - ZZW(:)
PRRS(:) = PRRS(:) + ZZW(:)
END WHERE
+!$acc end kernels
ELSEIF (CSUBG_RC_RR_ACCR=='PRFR') THEN
+#ifdef _OPENACC
+ CALL PRINT_MSG(NVERB_ERROR,'GEN','RAIN_ICE_WARM','OPENACC: CSUBG_RC_RR_ACCR=="PRFR" not yet tested')
+#endif
+!$acc kernels
!Cloud water is concentrated over its fraction with possibly to parts with high and low content as set for autoconversion
!Rain is concnetrated over its fraction
!Rain in high content area fraction: PHLC_HCF
@@ -162,25 +208,40 @@ END IF
! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
! => min(PCF, PRF)-PHLC_HCF
ZZW(:) = 0.
- WHERE( PHLC_HRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 &
- .AND. PHLC_HCF(:)>0 )
+ GWORK(:) = PHLC_HRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 .AND. PHLC_HCF(:)>0
+ WHERE( GWORK(:) )
!Accretion due to rain falling in high cloud content
- ZZW(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
- * PLBDAR_RF(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT) &
+#ifndef MNH_BITREP
+ ZZW(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
+ * PLBDAR_RF(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) &
+ * PHLC_HCF
+#else
+ ZZW(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
+ * BR_POW(PLBDAR_RF(:),XEXCACCR) &
+ * BR_POW(PRHODREF(:),-XCEXVT) &
* PHLC_HCF
+#endif
END WHERE
- WHERE( PHLC_LRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 &
- .AND. PHLC_LCF(:)>0 )
+ GWORK(:) = PHLC_LRC(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. PRCS(:)>0.0 .AND. PHLC_LCF(:)>0
+ WHERE( GWORK(:) )
!We add acrretion due to rain falling in low cloud content
- ZZW(:) = ZZW(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
- * PLBDAR_RF(:)**XEXCACCR &
- * PRHODREF(:)**(-XCEXVT) &
+#ifndef MNH_BITREP
+ ZZW(:) = ZZW(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
+ * PLBDAR_RF(:)**XEXCACCR &
+ * PRHODREF(:)**(-XCEXVT) &
* (MIN(PCF(:), PRF(:))-PHLC_HCF(:))
+#else
+ ZZW(:) = ZZW(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
+ * BR_POW(PLBDAR_RF(:),XEXCACCR) &
+ * BR_POW(PRHODREF(:),-XCEXVT) &
+ * (MIN(PCF(:), PRF(:))-PHLC_HCF(:))
+#endif
END WHERE
ZZW(:)=MIN(PRCS(:), ZZW(:))
PRCS(:) = PRCS(:) - ZZW(:)
PRRS(:) = PRRS(:) + ZZW(:)
+!$acc end kernels
ELSE
!wrong CSUBG_RC_RR_ACCR case
@@ -188,33 +249,54 @@ END IF
CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
ENDIF
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 7,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'ACCR_BU_RRR')
+ IF (LBUDGET_RC) THEN
+!$acc update self(PRCS)
+ CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'ACCR_BU_RRC')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'ACCR_BU_RRR')
+ END IF
!
!* 4.4 compute the evaporation of r_r: RREVAV
!
+!$acc kernels
ZZW(:) = 0.0
+!$acc end kernels
IF (CSUBG_RR_EVAP=='NONE') THEN
+!$acc kernels
!Evaporation only when there's no cloud (RC must be 0)
- WHERE( (PRRT(:)>XRTMIN(3)) .AND. (PRCT(:)<=XRTMIN(2)) )
+ GWORK(:) = PRRT(:)>XRTMIN(3) .AND. PRCT(:)<=XRTMIN(2)
+ WHERE( GWORK(:) )
+#ifndef MNH_BITREP
ZZW(:) = EXP( XALPW - XBETAW/PZT(:) - XGAMW*ALOG(PZT(:) ) ) ! es_w
+#else
+ ZZW(:) = BR_EXP( XALPW - XBETAW/PZT(:) - XGAMW*BR_LOG(PZT(:) ) ) ! es_w
+#endif
PUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) )
! Undersaturation over water
+#ifndef MNH_BITREP
ZZW(:) = ( XLVTT+(XCPV-XCL)*(PZT(:)-XTT) )**2 / ( PKA(:)*XRV*PZT(:)**2 ) &
+ ( XRV*PZT(:) ) / ( PDV(:)*ZZW(:) )
ZZW(:) = MIN( PRRS(:),( MAX( 0.0,PUSW(:) )/(PRHODREF(:)*ZZW(:)) ) * &
( X0EVAR*PLBDAR(:)**XEX0EVAR+X1EVAR*PCJ(:)*PLBDAR(:)**XEX1EVAR ) )
+#else
+ ZZW(:) = BR_P2( XLVTT+(XCPV-XCL)*(PZT(:)-XTT) ) / ( PKA(:)*XRV*BR_P2(PZT(:)) ) &
+ + ( XRV*PZT(:) ) / ( PDV(:)*ZZW(:) )
+ ZZW(:) = MIN( PRRS(:),( MAX( 0.0,PUSW(:) )/(PRHODREF(:)*ZZW(:)) ) * &
+ ( X0EVAR*BR_POW(PLBDAR(:),XEX0EVAR)+X1EVAR*PCJ(:)*BR_POW(PLBDAR(:),XEX1EVAR) ) )
+#endif
PRRS(:) = PRRS(:) - ZZW(:)
PRVS(:) = PRVS(:) + ZZW(:)
PTHS(:) = PTHS(:) - ZZW(:)*PLVFACT(:)
END WHERE
-
+!$acc end kernels
ELSEIF (CSUBG_RR_EVAP=='CLFR' .OR. CSUBG_RR_EVAP=='PRFR') THEN
+#ifdef _OPENACC
+ CALL PRINT_MSG(NVERB_ERROR,'GEN','RAIN_ICE_WARM','OPENACC: CSUBG_RR_EVAP=="CLFR" or "PRFR" not yet tested')
+#endif
+!$acc kernels
!Evaporation in clear sky part
!With CLFR, rain is diluted over the grid box
!With PRFR, rain is concentrated in its fraction
@@ -233,7 +315,8 @@ END IF
!et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
!On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
- WHERE( (PRRT(:)>XRTMIN(3)) .AND. ( ZZW4(:) > PCF(:) ) )
+ GWORK(:) = PRRT(:)>XRTMIN(3) .AND. ZZW4(:)>PCF(:)
+ WHERE( GWORK(:) )
! outside the cloud (environment) the use of T^u (unsaturated) instead of T
! Bechtold et al. 1993
!
@@ -241,16 +324,28 @@ END IF
ZZW2(:) = PTHLT(:) * PZT(:) / PTHT(:)
!
! es_w with new T^u
+#ifndef MNH_BITREP
ZZW(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
+#else
+ ZZW(:) = BR_EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*BR_LOG(ZZW2(:) ) )
+#endif
!
! S, Undersaturation over water (with new theta^u)
PUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) )
!
+#ifndef MNH_BITREP
ZZW(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
+ ( XRV*ZZW2(:) ) / ( PDV(:)*ZZW(:) )
!
ZZW(:) = MAX( 0.0,PUSW(:) )/(PRHODREF(:)*ZZW(:)) * &
( X0EVAR*ZZW3(:)**XEX0EVAR+X1EVAR*PCJ(:)*ZZW3(:)**XEX1EVAR )
+#else
+ ZZW(:) = BR_P2( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) ) / ( PKA(:)*XRV*BR_P2(ZZW2(:)) ) &
+ + ( XRV*ZZW2(:) ) / ( PDV(:)*ZZW(:) )
+ !
+ ZZW(:) = MAX( 0.0,PUSW(:) )/(PRHODREF(:)*ZZW(:)) * &
+ ( X0EVAR*BR_POW(ZZW3(:),XEX0EVAR)+X1EVAR*PCJ(:)*BR_POW(ZZW3(:),XEX1EVAR) )
+#endif
!
ZZW(:) = MIN( PRRS(:), ZZW(:) *( ZZW4(:) - PCF(:) ) )
!
@@ -258,26 +353,31 @@ END IF
PRVS(:) = PRVS(:) + ZZW(:)
PTHS(:) = PTHS(:) - ZZW(:)*PLVFACT(:)
END WHERE
+!$acc end kernels
ELSE
- !wrong CSUBG_RR_EVAP case
- WRITE(*,*) 'wrong CSUBG_RR_EVAP case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','wrong CSUBG_RR_EVAP case')
END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
- 4,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:), &
- 6,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
- 8,'REVA_BU_RRR')
+ IF (LBUDGET_TH) THEN
+!$acc update self(PTHS)
+ CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'REVA_BU_RTH')
+ END IF
+ IF (LBUDGET_RV) THEN
+!$acc update self(PRVS)
+ CALL BUDGET (UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:),6,'REVA_BU_RRV')
+ END IF
+ IF (LBUDGET_RR) THEN
+!$acc update self(PRRS)
+ CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'REVA_BU_RRR')
+ END IF
+!$acc kernels
+!$acc loop independent
DO JL = 1, KMICRO
PEVAP3D(K1(JL), K2(JL), K3(JL)) = ZZW( JL )
END DO
+!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 8927e5492e890511b9734f9291621fa6c6cbc98f..ddb031a7c175dff9a0ec9f6d11a948cb29f66593 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -454,7 +454,7 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
! OUT variables
!
-!$acc declare create(PSRCS)
+!$acc declare create(PSRCS, PRAINFR)
!
! Variables from modules
!$acc declare copyin(CSEDIM)
@@ -505,7 +505,7 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI
REAL,DIMENSION(SIZE(PTHS,1),SIZE(PTHS,2),SIZE(PTHS,3)) :: ZTHSSTEP
REAL,DIMENSION(SIZE(PRS,1),SIZE(PRS,2),SIZE(PRS,3),SIZE(PRS,4)) :: ZRSSTEP
!
-!$acc declare create(ZDZZ,ZEXN,ZLV,ZLS,ZCPH,ZZZ,ZSVT,ZSVS) create(ZT) device_resident(ZCOR,ZRSMIN) &
+!$acc declare create(ZDZZ,ZEXN,ZLV,ZLS,ZCPH,ZZZ,ZSVT,ZSVS) create(ZT) create(ZCOR,ZRSMIN) &
!$acc & create(ZTHSSTEP,ZRSSTEP,LLMICRO) &
!$acc & copyin(XRTMIN)
!
@@ -1206,6 +1206,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
! PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR,, PSEA,PTOWN, PFPR=ZFPR)
PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA=PSEA,PTOWN=PTOWN)
!$acc end data
+!$acc update self(PRAINFR)
ELSE
!$acc update device(PCIT,PCLDFR, &
!$acc & PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINDEP)
@@ -1227,7 +1228,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
! PSEA, PTOWN, PFPR=ZFPR )
PSEA, PTOWN )
!$acc end data
-!$acc update self(PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINDEP,PCIT)
+!$acc update self(PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINDEP,PCIT,PRAINFR)
END IF
!
!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
@@ -1312,6 +1313,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
! PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
PRT(:,:,:,7), PRS(:,:,:,7), PINPRH )
+!$acc update self(PRAINFR)
ELSE
!$acc update device(PCIT,PCLDFR)
!$acc data copyin(PSEA,PTOWN)
@@ -1329,7 +1331,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
! PRT(:,:,:,7), PRS(:,:,:,7), PINPRH,PFPR=ZFPR )
PRT(:,:,:,7), PRS(:,:,:,7), PINPRH)
!$acc end data
-!$acc update self(PCIT)
+!$acc update self(PCIT,PRAINFR)
END IF