diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index a04f63482dbfb138285d57f56511e7cb0a86d111..bb3883104ec94435005515ef4e2b721845f85857 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -264,6 +264,9 @@ INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
!
LOGICAL :: LPRETREATMENT, LNEW_ADJUST
!
+#ifdef _OPENACC
+PRINT *,'OPENACC: ICE_ADJUST being implemented'
+#endif
!-------------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index e2f9fd9196b28fe58f31914d89fe0ffd29b6926d..65c766ea997b8a5f5272496df8928666e033212a 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -17,38 +17,38 @@ INTERFACE
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, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, &
PSEA, PTOWN, &
- PRHT, PRHS, PINPRH,OCONVHG )
+ PRHT, PRHS, PINPRH, OCONVHG )
!
!
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Switch for Subgrid autoconversion
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
! Kind of Subgrid autoconversion method
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) :: KMI ! Model index
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
@@ -57,7 +57,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
@@ -67,23 +66,22 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
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) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: 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(:,:),OPTIONAL,INTENT(IN) :: PSEA
-REAL, DIMENSION(:,:),OPTIONAL,INTENT(IN) :: PTOWN
-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
-LOGICAL, OPTIONAL, INTENT(IN) :: OCONVHG! Switch for conversion from
- ! hail to graupel
-
+!
+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) :: 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(:,:), OPTIONAL, INTENT(IN) :: PSEA
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN
+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
+LOGICAL, OPTIONAL, INTENT(IN) :: OCONVHG ! Switch for conversion from
!
END SUBROUTINE RAIN_ICE
END INTERFACE
@@ -94,10 +92,10 @@ END MODULE MODI_RAIN_ICE
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, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, &
PSEA, PTOWN, &
- PRHT, PRHS, PINPRH,OCONVHG )
+ PRHT, PRHS, PINPRH, OCONVHG )
! #####################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -261,6 +259,10 @@ USE MODE_ll
USE MODE_PACK_PGI
#endif
!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -275,11 +277,11 @@ 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) :: KMI ! Model index
@@ -292,7 +294,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
@@ -312,20 +314,37 @@ 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) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: 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(:,:),OPTIONAL,INTENT(IN) :: PSEA
-REAL, DIMENSION(:,:),OPTIONAL,INTENT(IN) :: PTOWN
-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
-LOGICAL, OPTIONAL, INTENT(IN) :: OCONVHG! Switch for conversion from
- ! hail to graupel
+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) :: 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(:,:), OPTIONAL, INTENT(IN) :: PSEA
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN
+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
+LOGICAL, OPTIONAL, INTENT(IN) :: OCONVHG ! Switch for conversion from
+ ! hail to graupel
+!
+! IN variables
+!
+!$acc declare present(PDZZ,PRHODJ,PRHODREF,PEXNREF,PPABST, &
+!$acc & PCLDFR,PTHT,PRVT,PRCT,PRRT,PRIT,PRST,PRGT, &
+!$acc & PSIGS)
+!
+! INOUT variables
+!
+!$acc declare present(PCIT,PTHS,PRVS,PRCS,PRRS,PRIS,PRSS,PRGS,&
+!$acc & PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINDEP)
+
+!
+! OUT variables
+!
+!***NONE***
!
!* 0.2 Declarations of local variables :
!
@@ -446,7 +465,21 @@ REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
!
INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
+!$acc declare create(GNEGT,GMICRO,&
+!$acc & ZW,ZT, &
+!$acc & ZZW) &
+!$acc & device_resident(I1,I2,I3)
!
+#ifdef _OPENACC
+PRINT *,'OPENACC: RAIN_ICE being implemented'
+#endif
+#ifdef _OPENACC
+IF ( KRR == 7 ) THEN
+ PRINT *,'OPENACC: RAIN_ICE: KRR=7 being implemented'
+ PRINT *,'OPENACC: RAIN_ICE: KRR=7 not yet tested'
+ CALL ABORT
+END IF
+#endif
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE THE LOOP BOUNDS
@@ -458,7 +491,6 @@ IKE=KKU-JPVEXT*KKL
IKT=SIZE(PDZZ,3)
IKTB=1+JPVEXT
IKTE=IKT-JPVEXT
-
!
!
ZINVTSTEP=1./PTSTEP
@@ -473,6 +505,7 @@ CALL RAIN_ICE_NUCLEATION
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
+!$acc kernels present(GMICRO)
GMICRO(:,:,:) = .FALSE.
IF ( KRR == 7 ) THEN
@@ -491,8 +524,15 @@ 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
+!$acc update self(GMICRO)
+#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))
@@ -500,7 +540,7 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZRIT(IMICRO))
ALLOCATE(ZRST(IMICRO))
ALLOCATE(ZRGT(IMICRO))
- IF ( KRR == 7 ) ALLOCATE(ZRHT(IMICRO))
+ IF ( KRR == 7 ) ALLOCATE(ZRHT(IMICRO))
ALLOCATE(ZCIT(IMICRO))
ALLOCATE(ZRVS(IMICRO))
ALLOCATE(ZRCS(IMICRO))
@@ -508,7 +548,7 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZRIS(IMICRO))
ALLOCATE(ZRSS(IMICRO))
ALLOCATE(ZRGS(IMICRO))
- IF ( KRR == 7 ) ALLOCATE(ZRHS(IMICRO))
+ IF ( KRR == 7 ) ALLOCATE(ZRHS(IMICRO))
ALLOCATE(ZTHS(IMICRO))
ALLOCATE(ZRHODREF(IMICRO))
ALLOCATE(ZZT(IMICRO))
@@ -516,28 +556,47 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZEXNREF(IMICRO))
ALLOCATE(ZSIGMA_RC(IMICRO))
ALLOCATE(ZCF(IMICRO))
- DO JL=1,IMICRO
+!
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+!
+ ALLOCATE(ZUSW(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+!
+ ALLOCATE(ZLBDAR(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZLBDAG(IMICRO))
+ IF ( KRR == 7 ) ALLOCATE(ZLBDAH(IMICRO))
+ ALLOCATE(ZRDRYG(IMICRO))
+ ALLOCATE(ZRWETG(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+!
+ IF ( KRR == 7 ) THEN
+ ALLOCATE(ZZW1(IMICRO,7))
+ ELSE IF( KRR == 6 ) THEN
+ ALLOCATE(ZZW1(IMICRO,6))
+ ENDIF
+!
+!$acc kernels
+ 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))
- IF ( HSUBG_AUCV == 'SIGM') THEN
- ZSIGMA_RC(JL) = MAX(PSIGS(I1(JL),I2(JL),I3(JL)) * 2., 1.E-12)
- ELSE IF ( HSUBG_AUCV == 'CLFR') THEN
- ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
- 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))
@@ -545,35 +604,38 @@ IF( IMICRO >= 0 ) THEN
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(ZLBDAS(IMICRO))
- ALLOCATE(ZLBDAG(IMICRO))
- IF ( KRR == 7 ) ALLOCATE(ZLBDAH(IMICRO))
- ALLOCATE(ZRDRYG(IMICRO))
- ALLOCATE(ZRWETG(IMICRO))
- ALLOCATE(ZAI(IMICRO))
- ALLOCATE(ZCJ(IMICRO))
- ALLOCATE(ZKA(IMICRO))
- ALLOCATE(ZDV(IMICRO))
+ !
+ IF (KRR == 7 ) THEN
+ 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 == 'SIGM') THEN
+ DO JL=1,IMICRO
+ ZSIGMA_RC(JL) = MAX(PSIGS(I1(JL),I2(JL),I3(JL)) * 2., 1.E-12)
+ END DO
+ ELSE IF ( HSUBG_AUCV == 'CLFR') THEN
+ DO JL=1,IMICRO
+ ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
+ END DO
+ END IF
!
- IF ( KRR == 7 ) THEN
- ALLOCATE(ZZW1(IMICRO,7))
- ELSE IF( KRR == 6 ) THEN
- ALLOCATE(ZZW1(IMICRO,6))
- ENDIF
+ 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)
+
+!$acc end kernels
+!$acc update self(ZZW)
+!acc kernels
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+!$acc update device(ZZW)
+!$acc kernels
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+!$acc end kernels
!
IF (LBU_ENABLE .OR. LLES_CALL .OR. LCHECK) THEN
ALLOCATE(ZRHODJ(IMICRO))
@@ -641,24 +703,33 @@ IF( IMICRO >= 0 ) THEN
!
ZW(:,:,:) = PRVS(:,:,:)
PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PRVS)
ZW(:,:,:) = PRCS(:,:,:)
PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PRCS)
ZW(:,:,:) = PRRS(:,:,:)
PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PRRS)
ZW(:,:,:) = PRIS(:,:,:)
PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PRIS)
ZW(:,:,:) = PRSS(:,:,:)
PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PRSS)
ZW(:,:,:) = PRGS(:,:,:)
PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PRGS)
IF ( KRR == 7 ) THEN
ZW(:,:,:) = PRHS(:,:,:)
PRHS(:,:,:) = UNPACK( ZRHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PRHS)
END IF
ZW(:,:,:) = PTHS(:,:,:)
PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PTHS)
ZW(:,:,:) = PCIT(:,:,:)
PCIT(:,:,:) = UNPACK( ZCIT(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!$acc update device(PCIT)
!
!
!
@@ -668,7 +739,7 @@ IF( IMICRO >= 0 ) THEN
DEALLOCATE(ZRDRYG)
DEALLOCATE(ZRWETG)
DEALLOCATE(ZLBDAG)
- IF ( KRR == 7 ) DEALLOCATE(ZLBDAH)
+ IF ( KRR == 7 ) DEALLOCATE(ZLBDAH)
DEALLOCATE(ZLBDAS)
DEALLOCATE(ZLBDAR)
DEALLOCATE(ZSSI)
@@ -816,6 +887,8 @@ ELSE
STOP
END IF
+!$acc update device(PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINDEP)
+
!
!
!-------------------------------------------------------------------------------
@@ -868,16 +941,29 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D !
!
! O. Initialization of for sedimentation
!
+!$acc kernels
IF (OSEDIC) PINPRC (:,:) = 0.
PINPRR (:,:) = 0.
PINPRR3D (:,:,:) = 0.
PINPRS (:,:) = 0.
PINPRG (:,:) = 0.
IF ( KRR == 7 ) PINPRH (:,:) = 0.
+!$acc end kernels
+IF (OSEDIC) THEN
+!$acc update self(PINPRC)
+ENDIF
+!$acc update self(PINPRR,PINPRR3D,PINPRS,PINPRG)
+IF ( KRR == 7 ) THEN
+!$acc update self(PINPRH)
+ENDIF
!
!* 1. Parameters for cloud sedimentation
!
IF (OSEDIC) THEN
+#ifdef _OPENACC
+ PRINT *,'OPENACC: RAIN_ICE_SEDIMENTATION_SPLIT::OSDIC=.T. not yet implemented'
+ CALL ABORT
+#endif
ZRAY(:,:,:) = 0.
ZLBC(:,:,:) = XLBC(1)
ZFSEDC(:,:,:) = XFSEDC(1)
@@ -907,6 +993,7 @@ IF ( KRR == 7 ) PINPRH (:,:) = 0.
! the precipitating fields are larger than a minimal value only !!!
! For optimization we consider each variable separately
+!$acc kernels
ZRTMIN(:) = XRTMIN(:) * ZINVTSTEP
IF (OSEDIC) GSEDIMC(:,:,:) = .FALSE.
GSEDIMR(:,:,:) = .FALSE.
@@ -921,6 +1008,7 @@ ILENALLOCI = 0
ILENALLOCS = 0
ILENALLOCG = 0
IF ( KRR == 7 ) ILENALLOCH = 0
+!$acc end kernels
!
! ZPiS = Specie i source creating during the current time step
! PRiS = Source of the previous time step
@@ -1766,42 +1854,56 @@ IMPLICIT NONE
!
INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
+REAL :: ZZWMAX
+!$acc device_resident(I1,I2,I3)
!
!-------------------------------------------------------------------------------
!
!
! compute the temperature and the pressure
!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
+!$acc kernels present(GNEGT,ZT)
+#ifndef MNH_BITREP
+ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+#else
+ZT(:,:,:) = PTHT(:,:,:) * BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD)
+#endif
!
! optimization by looking for locations where
! the temperature is negative only !!!
!
GNEGT(:,:,:) = .FALSE.
GNEGT(IIB:IIE,IJB:IJE,IKTB:IKTE) = ZT(IIB:IIE,IJB:IJE,IKTB:IKTE)<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) = ZT(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) = ZT (I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ 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
!
!* 3.1 compute the heterogeneous nucleation source: RVHENI
!
@@ -1817,28 +1919,49 @@ IF( INEGT >= 1 ) THEN
( ZSSI(:)/ZUSW(:) )**XALPHA1 )
END WHERE
ZZW(:) = ZZW(:) - ZCIT(:)
- IF( MAXVAL(ZZW(:)) > 0.0 ) THEN
+ ZZWMAX = MAXVAL(ZZW(:))
+!$acc end kernels
+ IF( ZZWMAX > 0.0 ) THEN
!
!* 3.1.2 update the r_i and r_v mixing ratios
!
+!$acc kernels
ZZW(:) = MIN( ZZW(:),50.E3 ) ! limitation provisoire a 50 l^-1
+!$acc end kernels
+#ifndef _OPENACC
ZW(:,:,:) = UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 )
+#else
+ CALL UNPACK_DEVICE (ZZW,GNEGT,0.0,ZW)
+#endif
+!$acc kernels
ZW(:,:,:) = MAX( ZW(:,:,:) ,0.0 ) *XMNU0/(PRHODREF(:,:,:)*PTSTEP)
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
IF ( KRR == 7 ) THEN
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
+ /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))*PEXNREF(:,:,:) )
- ELSE IF( KRR == 6 ) THEN
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ ELSE IF( KRR == 6 ) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
+ /( (XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
+ XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))*PEXNREF(:,:,:) )
END IF
! f(L_s*(RVHENI))
ZZW(:) = MAX( ZZW(:)+ZCIT(:),ZCIT(:) )
+!$acc end kernels
+!acc update self(GNEGT)
+!acc update self(ZZW)
+#ifndef _OPENACC
PCIT(:,:,:) = MAX( UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 ) , &
PCIT(:,:,:) )
+#else
+ CALL UNPACK_DEVICE(ZZW,GNEGT,0.0,ZW)
+!$acc kernels
+ PCIT(:,:,:) = MAX( ZW(:,:,:), PCIT(:,:,:) )
+!$acc end kernels
+#endif
+!$acc update self(PRIS,PRVS,PTHS)
+!$acc update self(PCIT)
END IF
DEALLOCATE(ZSSI)
DEALLOCATE(ZUSW)
@@ -1867,19 +1990,26 @@ IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HENU_BU_RRI')
!
IMPLICIT NONE
!
+LOGICAL,DIMENSION(:),ALLOCATABLE :: GWORK
+!$acc declare create(GWORK)
!-------------------------------------------------------------------------------
!
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
+ ALLOCATE(GWORK(IMICRO))
+!
+!$acc kernels
ZZW(:) = 0.0
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRCT(:)>XRTMIN(2)) .AND. (ZRCS(:)>0.) )
+ GWORK =(ZZT(:)<XTT-35.0) .AND. (ZRCT(:)>XRTMIN(2)) .AND. (ZRCS(:)>0.)
+ WHERE (GWORK)
ZZW(:) = MIN( ZRCS(:),XHON*ZRHODREF(:)*ZRCT(:) &
*EXP( XALPHA3*(ZZT(:)-XTT)-XBETA3 ) )
ZRIS(:) = ZRIS(:) + ZZW(:)
ZRCS(:) = ZRCS(:) - ZZW(:)
ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
ENDWHERE
+!$acc end kernels
!
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
@@ -1893,13 +2023,16 @@ IMPLICIT NONE
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
+!$acc kernels
ZZW(:) = 0.0
- WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRRS(:)>0.) )
+ GWORK = (ZZT(:)<XTT-35.0) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRRS(:)>0.)
+ WHERE (GWORK)
ZZW(:) = MIN( ZRRS(:),ZRRT(:)* ZINVTSTEP )
ZRGS(:) = ZRGS(:) + ZZW(:)
ZRRS(:) = ZRRS(:) - ZZW(:)
ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRHONG))
ENDWHERE
+!$acc end kernels
!
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
@@ -1913,8 +2046,10 @@ IMPLICIT NONE
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
!
+!acc kernels
ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+!acc end kernels
!
!* 3.4.1 compute the thermodynamical function A_i(T,P)
!* and the c^prime_j (in the ventilation factor)
@@ -2024,6 +2159,8 @@ IMPLICIT NONE
IF (LBUDGET_RG) CALL BUDGET ( &
UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
11,'DEPG_BU_RRG')
+!
+ DEALLOCATE(GWORK)
!
END SUBROUTINE RAIN_ICE_SLOW
!
@@ -3130,6 +3267,50 @@ DO JK = 1,SIZE(LTAB,3)
END DO
!
END FUNCTION COUNTJV
+!
+!-------------------------------------------------------------------------------
+!
+#ifdef _OPENACC
+ SUBROUTINE COUNTJV_DEVICE(LTAB,I1,I2,I3,IC)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+!
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB ! Mask
+INTEGER, DIMENSION(:), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
+INTEGER, INTENT(OUT) :: IC ! Count
+!$acc declare present(LTAB,I1,I2,I3)
+!
+INTEGER :: JI,JJ,JK,IC
+!
+!-------------------------------------------------------------------------------
+!
+!$acc kernels
+IC = 0
+DO JK = 1,SIZE(LTAB,3)
+ DO JJ = 1,SIZE(LTAB,2)
+ DO JI = 1,SIZE(LTAB,1)
+ IF( LTAB(JI,JJ,JK) ) THEN
+ IC = IC +1
+ I1(IC) = JI
+ I2(IC) = JJ
+ I3(IC) = JK
+ END IF
+ END DO
+ END DO
+END DO
+!$acc end kernels
+!
+END SUBROUTINE COUNTJV_DEVICE
+#endif
+!
+!-------------------------------------------------------------------------------
+!
FUNCTION COUNTJV2(LTAB,I1,I2) RESULT(IC)
!
!* 0. DECLARATIONS
@@ -3161,4 +3342,59 @@ END FUNCTION COUNTJV2
!
!-------------------------------------------------------------------------------
!
+SUBROUTINE UNPACK_DEVICE (PVEC,OMASK,PFIELD,PMAT)
+!
+IMPLICIT NONE
+!
+REAL,DIMENSION(:), INTENT(IN) :: PVEC
+LOGICAL,DIMENSION(:,:,:),INTENT(IN) :: OMASK
+REAL, INTENT(IN) :: PFIELD
+REAL,DIMENSION(:,:,:), INTENT(OUT) :: PMAT
+!$acc declare present(PVEC,OMASK,PMAT)
+!
+INTEGER :: IDX, JI, JJ, JK
+INTEGER :: JIMAX, JJMAX, JKMAX
+!
+!PW: TODO: opti: store idx in mask array (logical->integer)
+!
+IF ( SIZE(OMASK,1)/=SIZE(PMAT,1) .OR. SIZE(OMASK,2)/=SIZE(PMAT,2) .OR. SIZE(OMASK,3)/=SIZE(PMAT,3) ) THEN
+ PRINT *,'FATAL: UNPACK_DEVICE: arrays are not conformant'
+ CALL ABORT
+END IF
+!
+IDX = 1
+JIMAX = SIZE(PMAT,1)
+JJMAX = SIZE(PMAT,2)
+JKMAX = SIZE(PMAT,3)
+!
+!$acc update self(OMASK,PVEC)
+!acc kernels
+DO JK = 1,JKMAX
+ DO JJ = 1,JJMAX
+ DO JI = 1,JIMAX
+ IF (OMASK(JI,JJ,JK)) THEN
+ PMAT(JI,JJ,JK) = PVEC(IDX)
+ IDX = IDX + 1
+ ELSE
+ PMAT(JI,JJ,JK) = PFIELD
+ END IF
+ END DO
+ END DO
+END DO
+!acc end kernels
+!$acc update device(PMAT)
+!
+IF (IDX-1 > SIZE(PVEC)) THEN
+ PRINT *,'FATAL: UNPACK_DEVICE: PVEC is too small'
+ CALL ABORT
+ELSE IF (IDX-1 < SIZE(PVEC)) THEN
+ PRINT *,'WARNING: UNPACK_DEVICE: some elements of PVEC were not used (',IDX-1,'/',SIZE(PVEC),')'
+!ELSE
+! PRINT *,'INFO: UNPACK_DEVICE: used all elements of PVEC (',IDX-1,'/',SIZE(PVEC),')'
+END IF
+!
+END SUBROUTINE UNPACK_DEVICE
+!
+!-------------------------------------------------------------------------------
+!
END SUBROUTINE RAIN_ICE
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index e8e2f2bdc9a3c6207c43cad5d986e7023e3c35da..9cc98fed55de2826f7aeca4de449a3034d1ccf6e 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -68,23 +68,23 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! THeta RADiative Tendancy
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
!
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
! concentration at time t
LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
! cloud droplet sedimentation
@@ -106,26 +106,27 @@ LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
! hail to graupel
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI !
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
END SUBROUTINE RESOLVED_CLOUD
END INTERFACE
@@ -292,6 +293,10 @@ USE MODI_LIMA_COLD
USE MODI_LIMA_MIXED
USE MODI_LIMA_ADJUST
!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -299,8 +304,8 @@ IMPLICIT NONE
!
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
! paramerization
-CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation
CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
@@ -341,23 +346,23 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
!
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! THeta RADiative Tendancy
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
!
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
! concentration at time t
LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
! cloud droplet sedimentation
@@ -367,6 +372,7 @@ LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
! evolution in C2R2 and KHKO
LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
! cloud droplet sedimentation
+ ! for C2R2 or KHKO
LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
! cloud crystal sedimentation
LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
@@ -378,26 +384,46 @@ LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
! hail to graupel
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI !
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+!PW: TODO: copyin variables only if used (depending on HCLOUD)
+!
+! IN variables
+!
+!$acc declare present(PRHODJ) &
+!$acc & copyin(PZZ,PRHODREF,PEXNREF,PPABST,PTHT,PSIGS,PSIGQSAT,PMFCONV,PTHM,PPABSM,PRCM,PW_ACT,PDTHRAD,&
+!$acc & PCF_MF,PRC_MF,PRI_MF)
+!In acc data: PSOLORG,PMI,PSEA,PTOWN
+!
+! INOUT variables
+!
+!$acc declare create(PTHS,PRT,PRS,PSVT,PSVS,PCLDFR,PCIT,&
+!$acc & PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINPRH,PINDEP,&
+!$acc & PSUPSAT,PNACT,PNPRO,PSSPRO)
+!
+! OUT variables
+!
+!$acc declare create(PSRCS)
!
!
!* 0.2 Declarations of local variables :
@@ -411,8 +437,7 @@ INTEGER :: IKB !
INTEGER :: IKE !
INTEGER :: IKU
INTEGER :: IINFO_ll ! return code of parallel routine
-INTEGER :: JK,JI,JL
-INTEGER :: I, J, K
+INTEGER :: JI,JJ,JK,JL
!
!
!
@@ -434,6 +459,8 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysi
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVS ! scalar tendency for microphysics only
!
INTEGER :: JMOD, JMOD_IFN
+LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
+!$acc declare create(ZDZZ,ZEXN,ZLV,ZLS,ZCPH,ZSVT,ZSVS) create(ZT) device_resident(ZCOR)
!
!------------------------------------------------------------------------------
!
@@ -445,6 +472,11 @@ IKB=1+JPVEXT
IKE=SIZE(PZZ,3) - JPVEXT
IKU=SIZE(PZZ,3)
!
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+GSOUTH = LSOUTH_ll()
+GNORTH = LNORTH_ll()
+!
IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN
ISVBEG = NSV_C2R2BEG
ISVEND = NSV_C2R2END
@@ -469,6 +501,8 @@ END IF
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
! ---------------------------------------
!
+!$acc update device(PTHS,PRT,PRS,PRHODJ)
+!$acc kernels present(PTHS,PRS,PRHODJ,PPABST,ZEXN,ZLV,ZLS,ZCPH,ZSVS)
PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
DO JRR = 1,KRR
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
@@ -496,10 +530,10 @@ END DO
!
! complete the physical boundaries to avoid some computations
!
-IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0
-IF(LEAST_ll() .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0
-IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0
-IF(LNORTH_ll() .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
+IF(GWEST .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0
+IF(GEAST .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0
+IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0
+IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
!
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
DO JI=1,JPHEXT
@@ -511,10 +545,10 @@ END DO
!
! complete the physical boundaries to avoid some computations
!
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZSVT(:IIB-1,:,:,:) = 0.0
- IF(LEAST_ll() .AND. HLBCX(2) /= 'CYCL') ZSVT(IIE+1:,:,:,:) = 0.0
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZSVT(:,:IJB-1,:,:) = 0.0
- IF(LNORTH_ll() .AND. HLBCY(2) /= 'CYCL') ZSVT(:,IJE+1:,:,:) = 0.0
+ IF(GWEST .AND. HLBCX(1) /= 'CYCL') ZSVT(:IIB-1,:,:,:) = 0.0
+ IF(GEAST .AND. HLBCX(2) /= 'CYCL') ZSVT(IIE+1:,:,:,:) = 0.0
+ IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') ZSVT(:,:IJB-1,:,:) = 0.0
+ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') ZSVT(:,IJE+1:,:,:) = 0.0
ENDIF
!
! complete the vertical boundaries
@@ -540,11 +574,20 @@ ENDIF
! microphysical routines would save
! computing time
!
-ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+#ifndef MNH_BITREP
+ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+#else
+ZEXN(:,:,:) = BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD)
+#endif
ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+!$acc end kernels
+!$acc update self(PTHS,PRT,PRS,ZEXN,ZLV,ZLS,ZCPH)
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+!$acc update self(ZSVS,ZSVT)
+ENDIF
!
!
!* 3. REMOVE NEGATIVE VALUES
@@ -577,6 +620,7 @@ IF (HCLOUD == 'KESS' .OR. HCLOUD == 'ICE3' .OR. HCLOUD == 'C2R2' .OR. &
!
ZRATIO = ZMASSTOT / ZMASSPOS
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
+!$acc update device(PRS)
!
END IF
END SELECT
@@ -587,6 +631,10 @@ END IF
!
SELECT CASE ( HCLOUD )
CASE('KESS')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::KESS not yet implemented'
+CALL ABORT
+#endif
WHERE (PRS(:,:,:,2) < 0.)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
@@ -616,6 +664,7 @@ SELECT CASE ( HCLOUD )
!
!
CASE('ICE3','ICE4')
+#ifndef _OPENACC
WHERE (PRS(:,:,:,4) < 0.)
PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
@@ -649,8 +698,55 @@ SELECT CASE ( HCLOUD )
PRS(:,:,:,4) = PRS(:,:,:,4) -ZCOR(:,:,:)
END WHERE
END IF
+#else
+!$acc kernels present(PTHS,PRS) present(ZEXN,ZLV,ZLS,ZCPH,ZCOR)
+ DO JK=1,SIZE(PZZ,3)
+ DO JJ=1,SIZE(PZZ,2)
+ DO JI=1,SIZE(PZZ,1)
+ IF (PRS(JI,JJ,JK,4) < 0.) THEN
+ PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,4)
+ PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,4) * ZLS(JI,JJ,JK) / &
+ ZCPH(JI,JJ,JK) / ZEXN(JI,JJ,JK)
+ PRS(JI,JJ,JK,4) = 0.
+ END IF
+ ! cloud
+ IF (PRS(JI,JJ,JK,2) < 0.) THEN
+ PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,2)
+ PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,2) * ZLV(JI,JJ,JK) / &
+ ZCPH(JI,JJ,JK) / ZEXN(JI,JJ,JK)
+ PRS(JI,JJ,JK,2) = 0.
+ ELSE
+ ! if rc or ri are positive, we can correct negative rv
+ ! cloud
+ IF (PRS(JI,JJ,JK,1) < 0.) THEN
+ PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,2)
+ PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,2) * ZLV(JI,JJ,JK) / &
+ ZCPH(JI,JJ,JK) / ZEXN(JI,JJ,JK)
+ PRS(JI,JJ,JK,2) = 0.
+ ! ice
+ IF(KRR > 3 .AND. PRS(JI,JJ,JK,4) > 0.) THEN
+ ZCOR(JI,JJ,JK) = MIN(-PRS(JI,JJ,JK,1),PRS(JI,JJ,JK,4))
+ PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + ZCOR(JI,JJ,JK)
+ PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - ZCOR(JI,JJ,JK) * ZLS(JI,JJ,JK) / &
+ ZCPH(JI,JJ,JK) / ZEXN(JI,JJ,JK)
+ PRS(JI,JJ,JK,4) = PRS(JI,JJ,JK,4) -ZCOR(JI,JJ,JK)
+ END IF
+ END IF
+ END IF
+ END DO
+ END DO
+ END DO
+!$acc end kernels
+!$acc update self(PRS,PTHS)
+!
+!
+#endif
!
CASE('C3R5')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::C3R5 not yet implemented'
+CALL ABORT
+#endif
WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
ZSVS(:,:,:,1) = 0.0
END WHERE
@@ -683,6 +779,9 @@ SELECT CASE ( HCLOUD )
PSVS(:,:,:,:) = MAX( 0.0,PSVS(:,:,:,:) )
!
CASE('LIMA')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::LIMA not yet implemented'
+#endif
! Correction of CCN concentrations where rc<0 or Nc<0
IF (OWARM) THEN
DO JMOD = 1, NMOD_CCN
@@ -791,6 +890,10 @@ END IF
!
SELECT CASE ( HCLOUD )
CASE ('REVE')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::REVE not yet implemented'
+CALL ABORT
+#endif
!
!* 4. REVERSIBLE MICROPHYSICAL SCHEME
! -------------------------------
@@ -804,6 +907,10 @@ SELECT CASE ( HCLOUD )
PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
!
CASE ('KESS')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::KESS not yet implemented'
+CALL ABORT
+#endif
!
!* 5. KESSLER MICROPHYSICAL SCHEME
! ----------------------------
@@ -829,6 +936,10 @@ SELECT CASE ( HCLOUD )
!
!
CASE ('C2R2','KHKO')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::C2R2//KHKO not yet implemented'
+CALL ABORT
+#endif
!
!* 7. 2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO
! ---------------------------------------
@@ -837,6 +948,7 @@ SELECT CASE ( HCLOUD )
!* 7.1 Compute the explicit microphysical sources
!
!
+!$acc data copyin(PSOLORG,PMI)
CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, PRHODREF, PEXNREF, &
PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
@@ -847,6 +959,7 @@ SELECT CASE ( HCLOUD )
PINPRC, PINPRR, PINPRR3D, PEVAP3D , &
PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN, &
PINDEP, PSUPSAT, PNACT )
+!$acc end data
!
!
!* 7.2 Perform the saturation adjustment
@@ -870,6 +983,9 @@ SELECT CASE ( HCLOUD )
END IF
!
CASE ('ICE3')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::ICE3 being implemented'
+#endif
!
!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
! -----------------------------------------------------
@@ -878,9 +994,15 @@ SELECT CASE ( HCLOUD )
!* 9.1 Compute the explicit microphysical sources
!
!
+!$acc kernels present(ZDZZ,PZZ)
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
+!$acc end kernels
+!$acc update self(ZDZZ)
+!$acc update device(PCIT,PCLDFR)
+!$acc update device(PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINDEP)
+!$acc data copyin(PSEA,PTOWN)
CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
KSPLITR, PTSTEP, KMI, KRR, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
@@ -889,9 +1011,12 @@ SELECT CASE ( HCLOUD )
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS,PINDEP, &
- PSEA,PTOWN)
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, &
+ PSEA, PTOWN)
+!$acc end data
+!$acc update self(PINPRC,PINPRR,PINPRR3D,PEVAP3D,PINPRS,PINPRG,PINDEP)
+!$acc update self(PCIT)
!
!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
!
@@ -909,6 +1034,10 @@ SELECT CASE ( HCLOUD )
PRGT=PRT(:,:,:,6), PRGS=PRS(:,:,:,6) )
!
CASE ('ICE4')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::ICE4 not yet implemented'
+CALL ABORT
+#endif
!
!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
! -----------------------------------------------------
@@ -917,9 +1046,14 @@ SELECT CASE ( HCLOUD )
!* 10.1 Compute the explicit microphysical sources
!
!
+!$acc kernels present(ZDZZ,PZZ)
DO JK=IKB,IKE
ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
ENDDO
+!$acc end kernels
+!$acc update self(ZDZZ)
+!$acc update device(PCIT,PCLDFR)
+!$acc data copyin(PSEA,PTOWN)
CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
KSPLITR, PTSTEP, KMI, KRR, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
@@ -928,11 +1062,12 @@ SELECT CASE ( HCLOUD )
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS,PINDEP, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, PINDEP, &
PSEA, PTOWN, &
PRT(:,:,:,7), PRS(:,:,:,7), PINPRH,OCONVHG )
-
+!$acc end data
+!$acc update self(PCIT)
!
!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
!
@@ -957,6 +1092,10 @@ SELECT CASE ( HCLOUD )
!* 12.1 Compute the explicit microphysical sources
!
CASE ('LIMA')
+#ifdef _OPENACC
+PRINT *,'OPENACC: RESOLVED_CLOUD::LIMA not yet implemented'
+CALL ABORT
+#endif
!
IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ,&
@@ -1018,11 +1157,15 @@ END IF
!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES
! ---------------------------------------
!
+!$acc update device(PTHS,PRS)
+!$acc kernels
PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
!
DO JRR = 1,KRR
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
END DO
+!$acc end kernels
+!$acc update self(PTHS,PRS)
!
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
DO JSV = 1,SIZE(ZSVS,4)