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

Juan 31/05/2024:condensation.f90 , First GPU beta version with acc kernels inside JK loop

parent 667be2b4
No related branches found
No related tags found
No related merge requests found
......@@ -192,6 +192,9 @@ REAL :: ZDZFACT,ZDZREF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER :: IERR
!
LOGICAL :: GPRESENT_PLV, GPRESENT_PLS, GPRESENT_PCPH
LOGICAL :: GPRESENT_PHLC_HCF, GPRESENT_PHLC_HRC, GPRESENT_PHLI_HCF, GPRESENT_PHLI_HRI
LOGICAL :: GHLAMBDA3_CB
!
!* 0.3 Definition of constants :
!
......@@ -226,11 +229,23 @@ IKL=D%NKL
IIJB=D%NIJB
IIJE=D%NIJE
!
GPRESENT_PLV = PRESENT(PLV)
GPRESENT_PLS = PRESENT(PLS)
GPRESENT_PCPH = PRESENT(PCPH)
GPRESENT_PHLC_HCF = PRESENT(PHLC_HCF)
GPRESENT_PHLC_HRC = PRESENT(PHLC_HRC)
GPRESENT_PHLI_HCF = PRESENT(PHLI_HCF)
GPRESENT_PHLI_HRI = PRESENT(PHLI_HRI)
!
GHLAMBDA3_CB = (HLAMBDA3=='CB')
!
!$acc kernels present_cr(ZRT)
PCLDFR(:,:) = 0. ! Initialize values
PSIGRC(:,:) = 0. ! Initialize values
PRV_OUT(:,:)= 0. ! Initialize values
PRC_OUT(:,:)= 0. ! Initialize values
PRI_OUT(:,:)= 0. ! Initialize values
!$acc end kernels
ZPRIFACT = 1. ! Initialize value
ZARDUM2 = 0. ! Initialize values
ZCLDINI = -1. ! Dummy Initialized cloud input to icecloud routine
......@@ -243,18 +258,24 @@ IF(OCND2)ZPRIFACT = 0.
!
!-------------------------------------------------------------------------------
! store total water mixing ratio
!$acc kernels present_cr(ZRT)
DO JK=IKTB,IKTE
DO JIJ=IIJB,IIJE
ZRT(JIJ,JK) = PRV_IN(JIJ,JK) + PRC_IN(JIJ,JK) + PRI_IN(JIJ,JK)*ZPRIFACT
END DO
END DO
!$acc end kernels
!-------------------------------------------------------------------------------
! Preliminary calculations
! latent heat of vaporisation/sublimation
IF(PRESENT(PLV) .AND. PRESENT(PLS)) THEN
IF(GPRESENT_PLV .AND. GPRESENT_PLS) THEN
!$acc kernels present_cr(ZLV,ZLS)
ZLV(:,:)=PLV(:,:)
ZLS(:,:)=PLS(:,:)
!$acc end kernels
ELSE
!$acc kernels present_cr(ZLV, ZLS)
!$acc loop collapse(2) independent
DO JK=IKTB,IKTE
DO JIJ=IIJB,IIJE
! latent heat of vaporisation/sublimation
......@@ -262,11 +283,15 @@ ELSE
ZLS(JIJ,JK) = CST%XLSTT + ( CST%XCPV - CST%XCI ) * ( PT(JIJ,JK) - CST%XTT )
ENDDO
ENDDO
!$acc end kernels
ENDIF
IF(PRESENT(PCPH)) THEN
IF(GPRESENT_PCPH) THEN
!$acc kernels present_cr(ZCPD)
ZCPD(:,:)=PCPH(:,:)
!$acc end kernels
ELSE
DO JK=IKTB,IKTE
!$acc kernels present_cr(ZCPD)
DO JK=IKTB,IKTE
DO JIJ=IIJB,IIJE
ZCPD(JIJ,JK) = CST%XCPD + CST%XCPV*PRV_IN(JIJ,JK) + CST%XCL*PRC_IN(JIJ,JK) + CST%XCI*PRI_IN(JIJ,JK) + &
#if defined(REPRO48)
......@@ -276,9 +301,12 @@ ELSE
CST%XCI*(PRS(JIJ,JK) + PRG(JIJ,JK) )
ENDDO
ENDDO
!$acc end kernels
ENDIF
! Preliminary calculations needed for computing the "turbulent part" of Sigma_s
IF ( .NOT. OSIGMAS ) THEN
!$acc kernels present_cr(ZTLK,ITPL,ZTMIN,ZZZP)
!$acc loop collapse(2) independent
DO JK=IKTB,IKTE
DO JIJ=IIJB,IIJE
! store temperature at saturation
......@@ -296,7 +324,9 @@ IF ( .NOT. OSIGMAS ) THEN
ITPL(:) = IKB+IKL
#endif
ZTMIN(:) = 400.
!$acc loop seq
DO JK = IKTB+1,IKTE-1
!$acc loop independent
DO JIJ=IIJB,IIJE
IF ( PT(JIJ,JK) < ZTMIN(JIJ) ) THEN
ZTMIN(JIJ) = PT(JIJ,JK)
......@@ -306,7 +336,9 @@ IF ( .NOT. OSIGMAS ) THEN
END DO
! Set the mixing length scale
ZL(:,IKB) = 20.
!$acc loop seq
DO JK = IKB+IKL,IKE,IKL
!$acc loop independent gang vector private(ZZZ,JKP)
DO JIJ=IIJB,IIJE
! free troposphere
ZL(JIJ,JK) = ZL0
......@@ -319,6 +351,7 @@ IF ( .NOT. OSIGMAS ) THEN
ZL(JIJ,JK) = .6 * ZL(JIJ,JK-IKL)
END DO
END DO
!$acc end kernels
END IF
!-------------------------------------------------------------------------------
!
......@@ -326,29 +359,38 @@ DO JK=IKTB,IKTE
JKP=MAX(MIN(JK+IKL,IKTE),IKTB)
JKM=MAX(MIN(JK-IKL,IKTE),IKTB)
IF (OCND2) THEN
!$acc kernels
DO JIJ = IIJB, IIJE
ZDZ(JIJ) = PZZ(JIJ,JKP) - PZZ(JIJ,JKP-IKL)
ENDDO
CALL ICECLOUD(D,PPABS(:,JK),PZZ(:,JK),ZDZ(:), &
!$acc end kernels
CALL ICECLOUD(D,PPABS(:,JK),PZZ(:,JK),ZDZ(:), &
& PT(:,JK),PRV_IN(:,JK),1.,-1., &
& ZCLDINI(:),PIFR(IIJB,JK),PICLDFR(:,JK), &
& PSSIO(:,JK),PSSIU(:,JK),ZARDUM2(:),ZARDUM(:))
! latent heats
! saturated water vapor mixing ratio over liquid water and ice
!$acc kernels
!$acc loop independent
DO JIJ=IIJB,IIJE
ESATW_T(JIJ)=ESATW(PT(JIJ,JK))
ZPV(JIJ) = MIN(ESATW_T(JIJ), .99*PPABS(JIJ,JK))
ZPIV(JIJ) = MIN(ESATI(PT(JIJ,JK)), .99*PPABS(JIJ,JK))
END DO
!$acc end kernels
ELSE
! latent heats
! saturated water vapor mixing ratio over liquid water and ice
!$acc kernels
!$acc loop independent
DO JIJ=IIJB,IIJE
ZPV(JIJ) = MIN(EXP( CST%XALPW - CST%XBETAW / PT(JIJ,JK) - CST%XGAMW * LOG( PT(JIJ,JK) ) ), .99*PPABS(JIJ,JK))
ZPIV(JIJ) = MIN(EXP( CST%XALPI - CST%XBETAI / PT(JIJ,JK) - CST%XGAMI * LOG( PT(JIJ,JK) ) ), .99*PPABS(JIJ,JK))
END DO
!$acc end kernels
ENDIF
!Ice fraction
!$acc kernels
ZFRAC(:) = 0.
IF (OUSERI .AND. .NOT.OCND2) THEN
DO JIJ=IIJB,IIJE
......@@ -356,10 +398,14 @@ DO JK=IKTB,IKTE
ZFRAC(JIJ) = PRI_IN(JIJ,JK) / (PRC_IN(JIJ,JK)+PRI_IN(JIJ,JK))
ENDIF
END DO
!$acc loop independent private(ierr)
DO JIJ=IIJB,IIJE
CALL COMPUTE_FRAC_ICE(HFRAC_ICE, NEB, ZFRAC(JIJ), PT(JIJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
ENDDO
ENDIF
!$acc end kernels
!$acc kernels
!$acc loop independent
DO JIJ=IIJB,IIJE
ZQSL(JIJ) = CST%XRD / CST%XRV * ZPV(JIJ) / ( PPABS(JIJ,JK) - ZPV(JIJ) )
ZQSI(JIJ) = CST%XRD / CST%XRV * ZPIV(JIJ) / ( PPABS(JIJ,JK) - ZPIV(JIJ) )
......@@ -376,9 +422,12 @@ DO JK=IKTB,IKTE
ZSBAR(JIJ) = ZA(JIJ) * ( ZRT(JIJ,JK) - ZQSL(JIJ) + &
& ZAH * ZLVS * (PRC_IN(JIJ,JK)+PRI_IN(JIJ,JK)*ZPRIFACT) / ZCPD(JIJ,JK))
END DO
!$acc end kernels
! switch to take either present computed value of SIGMAS
! or that of Meso-NH turbulence scheme
!$acc kernels
IF ( OSIGMAS ) THEN
!$acc loop independent
DO JIJ=IIJB,IIJE
IF (PSIGQSAT(JIJ)/=0.) THEN
ZDZFACT = 1.
......@@ -401,6 +450,7 @@ DO JK=IKTB,IKTE
END IF
END DO
ELSE
!$acc loop independent
DO JIJ=IIJB,IIJE
! parameterize Sigma_s with first_order closure
DZZ = PZZ(JIJ,JKP) - PZZ(JIJ,JKM)
......@@ -416,6 +466,9 @@ DO JK=IKTB,IKTE
ZSIG_CONV * ZSIG_CONV ) )
END DO
END IF
!$acc end kernels
!$acc kernels
!$acc loop independent
DO JIJ=IIJB,IIJE
ZSIGMA(JIJ)= MAX( 1.E-10, ZSIGMA(JIJ) )
......@@ -423,6 +476,7 @@ DO JK=IKTB,IKTE
ZQ1(JIJ) = ZSBAR(JIJ)/ZSIGMA(JIJ)
END DO
IF(HCONDENS == 'GAUS') THEN
!$acc loop independent ! private(zgcond)
DO JIJ=IIJB,IIJE
! Gaussian Probability Density Function around ZQ1
! Computation of ZG and ZGAM(=erf(ZG))
......@@ -479,6 +533,7 @@ DO JK=IKTB,IKTE
ENDIF
ELSEIF(HCONDENS == 'CB02')THEN
!$acc loop independent
DO JIJ=IIJB,IIJE
!Total condensate
IF (ZQ1(JIJ) > 0. .AND. ZQ1(JIJ) <= 2) THEN
......@@ -514,7 +569,8 @@ DO JK=IKTB,IKTE
PHLI_HRI(:,JK)=0.
ENDIF
END IF !HCONDENS
!$acc end kernels
!$acc kernels
IF(.NOT. OCND2) THEN
DO JIJ=IIJB,IIJE
PRC_OUT(JIJ,JK) = (1.-ZFRAC(JIJ)) * ZCOND(JIJ) ! liquid condensate
......@@ -575,7 +631,9 @@ DO JK=IKTB,IKTE
PRV_OUT(JIJ,JK) = ZRT(JIJ,JK) - PRC_OUT(JIJ,JK) - PRI_OUT(JIJ,JK)*ZPRIFACT
END DO
END IF ! End OCND2
IF(HLAMBDA3=='CB')THEN
!$acc end kernels
!$acc kernels
IF(GHLAMBDA3_CB)THEN
DO JIJ=IIJB,IIJE
! s r_c/ sig_s^2
! PSIGRC(JIJ,JK) = PCLDFR(JIJ,JK) ! use simple Gaussian relation
......@@ -588,11 +646,12 @@ DO JK=IKTB,IKTE
PSIGRC(JIJ,JK) = PSIGRC(JIJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1(JIJ)) )
END DO
END IF
!$acc end kernels
END DO
!
IF (LHOOK) CALL DR_HOOK('CONDENSATION',1,ZHOOK_HANDLE)
!
CONTAINS
INCLUDE "compute_frac_ice.func.h"
#include "compute_frac_ice.func.h"
!
END SUBROUTINE CONDENSATION
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment