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

Juan 30/05/2024:rain_ice_nucleation.f90 , add !$acc kernels & replace MAXVAL...

Juan 30/05/2024:rain_ice_nucleation.f90 , add !$acc kernels & replace MAXVAL with "!$acc loop reduction(max:ZZWMAX)"
parent 6411fb45
No related branches found
No related tags found
No related merge requests found
......@@ -35,7 +35,7 @@ use MODD_RAIN_ICE_PARAM, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10,
use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
use mode_tools, only: Countjv_device
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
......@@ -78,6 +78,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
ZSSI ! Supersaturation over ice
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: ZW ! work array
REAL :: ZZWMAX
!
!-------------------------------------------------------------------------------
......@@ -87,28 +88,36 @@ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HIN', pris(:, :
!
! compute the temperature and the pressure
!
!$acc kernels
PT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
!$acc end kernels
!
! optimization by looking for locations where
! the temperature is negative only !!!
!
!$acc kernels present_cr(GNEGT)
GNEGT(:,:,:) = .FALSE.
GNEGT(KIB:KIE,KJB:KJE,KKTB:KKTE) = PT(KIB:KIE,KJB:KJE,KKTB:KKTE)<XTT
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
!$acc end kernels
CALL COUNTJV_DEVICE(GNEGT(:,:,:),I1(:),I2(:),I3(:),INEGT)
IF( INEGT >= 1 ) THEN
ALLOCATE(ZRVT(INEGT)) ;
ALLOCATE(ZCIT(INEGT)) ;
ALLOCATE(ZZT(INEGT)) ;
ALLOCATE(ZPRES(INEGT));
!$acc kernels
!$acc loop independent
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
!$acc end kernels
ALLOCATE(ZZW(INEGT))
ALLOCATE(ZUSW(INEGT))
ALLOCATE(ZSSI(INEGT))
!$acc kernels
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
......@@ -132,7 +141,13 @@ IF( INEGT >= 1 ) THEN
( ZSSI(:)/ZUSW(:) )**XALPHA1 )
END WHERE
ZZW(:) = ZZW(:) - ZCIT(:)
IF( MAXVAL(ZZW(:)) > 0.0 ) THEN
ZZWMAX = 0.0
!$acc loop reduction(max:ZZWMAX)
DO JL=1,INEGT
ZZWMAX = MAX(ZZWMAX,ZZW(JL))
END DO
!$acc end kernels
IF( ZZWMAX > 0.0 ) THEN
!
!* 3.1.2 update the r_i and r_v mixing ratios
!
......
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