Skip to content
Snippets Groups Projects
Commit f70e2f17 authored by RODIER Quentin's avatar RODIER Quentin
Browse files

Quentin 09/10/2024: rain_ice_(old) OpenACC LAERO adaptation

parent 49315da8
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 1515 additions and 351 deletions
src/PHYEX/micro/rain_ice_fast_rg.f90
+ 490
− 125
View file @ f70e2f17
This diff is collapsed.
src/PHYEX/micro/rain_ice_fast_rh.f90
+ 44
− 5
View file @ f70e2f17
......@@ -41,6 +41,7 @@ use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
use mode_mppdb
use mode_msg
#ifndef MNH_OPENACC
use mode_tools, only: Countjv
......@@ -126,6 +127,37 @@ REAL, DIMENSION(:,:), pointer, contiguous :: ZZW1 ! Work arrays
CALL PRINT_MSG(NVERB_WARNING,'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")
CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE_FAST_RH beg:PRHODREF")
CALL MPPDB_CHECK(PRVT,"RAIN_ICE_FAST_RH beg:PRVT")
CALL MPPDB_CHECK(PRCT,"RAIN_ICE_FAST_RH beg:PRCT")
CALL MPPDB_CHECK(PRIT,"RAIN_ICE_FAST_RH beg:PRIT")
CALL MPPDB_CHECK(PRST,"RAIN_ICE_FAST_RH beg:PRST")
CALL MPPDB_CHECK(PRGT,"RAIN_ICE_FAST_RH beg:PRGT")
CALL MPPDB_CHECK(PRHT,"RAIN_ICE_FAST_RH beg:PRHT")
CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE_FAST_RH beg:PRHODJ")
CALL MPPDB_CHECK(PPRES,"RAIN_ICE_FAST_RH beg:PPRES")
CALL MPPDB_CHECK(PZT,"RAIN_ICE_FAST_RH beg:PZT")
CALL MPPDB_CHECK(PLBDAS,"RAIN_ICE_FAST_RH beg:PLBDAS")
CALL MPPDB_CHECK(PLBDAG,"RAIN_ICE_FAST_RH beg:PLBDAG")
CALL MPPDB_CHECK(PLSFACT,"RAIN_ICE_FAST_RH beg:PLSFACT")
CALL MPPDB_CHECK(PLVFACT,"RAIN_ICE_FAST_RH beg:PLVFACT")
CALL MPPDB_CHECK(PCJ,"RAIN_ICE_FAST_RH beg:PCJ")
CALL MPPDB_CHECK(PKA,"RAIN_ICE_FAST_RH beg:PKA")
CALL MPPDB_CHECK(PDV,"RAIN_ICE_FAST_RH beg:PDV")
!Check all INOUT arrays
CALL MPPDB_CHECK(PLBDAH,"RAIN_ICE_FAST_RH beg:PLBDAH")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RH beg:PRCS")
CALL MPPDB_CHECK(PRRS,"RAIN_ICE_FAST_RH beg:PRRS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_FAST_RH beg:PRIS")
CALL MPPDB_CHECK(PRSS,"RAIN_ICE_FAST_RH beg:PRSS")
CALL MPPDB_CHECK(PRGS,"RAIN_ICE_FAST_RH beg:PRGS")
CALL MPPDB_CHECK(PRHS,"RAIN_ICE_FAST_RH beg:PRHS")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_FAST_RH beg:PTHS")
CALL MPPDB_CHECK(PUSW,"RAIN_ICE_FAST_RH beg:PUSW")
END IF
!
#ifndef MNH_OPENACC
ALLOCATE( I1H (size(PRHODREF)) )
......@@ -270,13 +302,8 @@ CALL MNH_MEM_GET( ZZW1, SIZE(PRHODREF), 7 )
DO JJ = 1, IGWET
JL = I1W(JJ)
ZZW1(JL,3) = MIN( PRSS(JL),XFSWETH*ZVEC3(JJ) & ! RSWETH
#if defined(REPRO48)
*( ZVECLBDAS(JJ)**(XCXS-XBS) )*( ZVECLBDAH(JJ)**XCXH ) &
*( PRHODREF(JL)**(-XCEXVT-1.) ) &
#else
*PRST(JL)*( ZVECLBDAH(JJ)**XCXH ) &
*( PRHODREF(JL)**(-XCEXVT) ) &
#endif
*( XLBSWETH1/( ZVECLBDAH(JJ)**2 ) + &
XLBSWETH2/( ZVECLBDAH(JJ) * ZVECLBDAS(JJ) ) + &
XLBSWETH3/( ZVECLBDAS(JJ)**2) ) )
......@@ -528,6 +555,18 @@ CALL MNH_MEM_GET( ZZW1, SIZE(PRHODREF), 7 )
mask = omicro(:,:,:), field = 0. ) )
END IF
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PLBDAH,"RAIN_ICE_FAST_RH end:PLBDAH")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RH end:PRCS")
CALL MPPDB_CHECK(PRRS,"RAIN_ICE_FAST_RH end:PRRS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_FAST_RH end:PRIS")
CALL MPPDB_CHECK(PRSS,"RAIN_ICE_FAST_RH end:PRSS")
CALL MPPDB_CHECK(PRGS,"RAIN_ICE_FAST_RH end:PRGS")
CALL MPPDB_CHECK(PRHS,"RAIN_ICE_FAST_RH end:PRHS")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_FAST_RH end:PTHS")
CALL MPPDB_CHECK(PUSW,"RAIN_ICE_FAST_RH end:PUSW")
END IF
!$acc end data
......
src/PHYEX/micro/rain_ice_fast_ri.f90
+ 27
− 1
View file @ f70e2f17
......@@ -35,6 +35,7 @@ use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
use mode_mppdb
#if defined(MNH_BITREP) || defined(MNH_BITREP_OMP)
USE MODI_BITREP
......@@ -80,7 +81,7 @@ INTEGER :: JL,JLU
!
! IN variables
!
!$acc data present_crm( OMICRO, PRHODREF, PRIT, &
!$acc data present( OMICRO, PRHODREF, PRIT, &
!$acc & PRHODJ, PZT, PSSI, PLSFACT, PLVFACT, &
!$acc & PAI, PCJ, &
!
......@@ -92,6 +93,24 @@ INTEGER :: JL,JLU
!
!NONE
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(OMICRO,"RAIN_ICE_FAST_RI beg:OMICRO")
CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE_FAST_RI beg:PRHODREF")
CALL MPPDB_CHECK(PRIT,"RAIN_ICE_FAST_RI beg:PRIT")
CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE_FAST_RI beg:PRHODJ")
CALL MPPDB_CHECK(PZT,"RAIN_ICE_FAST_RI beg:PZT")
CALL MPPDB_CHECK(PSSI,"RAIN_ICE_FAST_RI beg:PSSI")
CALL MPPDB_CHECK(PLSFACT,"RAIN_ICE_FAST_RI beg:PLSFACT")
CALL MPPDB_CHECK(PLVFACT,"RAIN_ICE_FAST_RI beg:PLVFACT")
CALL MPPDB_CHECK(PAI,"RAIN_ICE_FAST_RI beg:PAI")
CALL MPPDB_CHECK(PCJ,"RAIN_ICE_FAST_RI beg:PCJ")
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"RAIN_ICE_FAST_RI beg:PCIT")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RI beg:PRCS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_FAST_RI beg:PRIS")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_FAST_RI beg:PTHS")
END IF
!
JLU = size(PRHODREF)
!
......@@ -189,6 +208,13 @@ CALL MNH_MEM_GET( ZLBEXI, SIZE(PRHODREF) )
mask = omicro(:,:,:), field = 0. ) )
if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', Unpack ( zzw(:) * prhodj(:), &
mask = omicro(:,:,:), field = 0. ) )
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"RAIN_ICE_FAST_RI end:PCIT")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RI end:PRCS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_FAST_RI end:PRIS")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_FAST_RI end:PTHS")
END IF
!$acc end data
......
src/PHYEX/micro/rain_ice_fast_rs.f90
+ 346
− 77
View file @ f70e2f17
This diff is collapsed.
src/PHYEX/micro/rain_ice_nucleation.f90
+ 264
− 65
View file @ f70e2f17
!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!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.
......@@ -34,7 +34,25 @@ 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_budget, only: Budget_store_init, Budget_store_end
use mode_mppdb
#ifndef MNH_OPENACC
use mode_tools, only: Countjv
#else
use mode_tools, only: Countjv_device
#endif
#if defined(MNH_BITREP) || defined(MNH_BITREP_OMP)
use modi_bitrep
#endif
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
#if defined(MNH_COMPILER_CCE) && defined(MNH_BITREP_OMP)
!$mnh_undef(LOOP)
!$mnh_undef(OPENACC)
#endif
IMPLICIT NONE
!
......@@ -64,102 +82,259 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
!
!* 0.2 declaration of local variables
!
INTEGER :: INEGT
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, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
ZPRES, & ! Pressure
ZZW, & ! Work array
ZUSW, & ! Undersaturation over water
ZSSI ! Supersaturation over ice
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: ZW ! work array
INTEGER :: INEGT
INTEGER :: JL ! and PACK intrinsics
INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: I1,I2,I3 ! Used to replace the COUNT
LOGICAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: GNEGT ! Test where to compute the HEN process
REAL :: ZZWMAX
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRVT ! Water vapor m.r. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZCIT ! Pristine ice conc. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZZT, & ! Temperature
ZPRES, & ! Pressure
ZZW, & ! Work array
ZUSW, & ! Undersaturation over water
ZSSI ! Supersaturation over ice
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZW ! work array
INTEGER :: JIU,JJU,JKU, JIJKU
INTEGER :: JI,JJ,JK
!
!-------------------------------------------------------------------------------
!
! IN variables
!
!$acc data present( PTHT, PPABST, PRHODJ, PRHODREF, PRVT, PRCT, &
!$acc & PRRT, PRIT, PRST, PRGT, PEXNREF, PRHT, &
!
! INOUT variables
!
!$acc & PCIT, PTHS, PRVS, PRIS, &
!
! OUT variables
!
!$acc & PT )
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PTHT,"RAIN_ICE_NUCLEATION beg:PTHT")
CALL MPPDB_CHECK(PPABST,"RAIN_ICE_NUCLEATION beg:PPABST")
CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE_NUCLEATION beg:PRHODJ")
CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE_NUCLEATION beg:PRHODREF")
CALL MPPDB_CHECK(PRVT,"RAIN_ICE_NUCLEATION beg:PRVT")
CALL MPPDB_CHECK(PRCT,"RAIN_ICE_NUCLEATION beg:PRCT")
CALL MPPDB_CHECK(PRRT,"RAIN_ICE_NUCLEATION beg:PRRT")
CALL MPPDB_CHECK(PRIT,"RAIN_ICE_NUCLEATION beg:PRIT")
CALL MPPDB_CHECK(PRST,"RAIN_ICE_NUCLEATION beg:PRST")
CALL MPPDB_CHECK(PRGT,"RAIN_ICE_NUCLEATION beg:PRGT")
CALL MPPDB_CHECK(PEXNREF,"RAIN_ICE_NUCLEATION beg:PEXNREF")
IF(PRESENT(PRHT)) CALL MPPDB_CHECK(PRHT,"RAIN_ICE_NUCLEATION beg:PRHT")
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"RAIN_ICE_NUCLEATION beg:PCIT")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_NUCLEATION beg:PTHS")
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_NUCLEATION beg:PRVS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_NUCLEATION beg:PRIS")
END IF
JIU = size(PEXNREF, 1 )
JJU = size(PEXNREF, 2 )
JKU = size(PEXNREF, 3 )
JIJKU = JIU * JJU * JKU
#ifndef MNH_OPENACC
allocate( i1( JIJKU ) )
allocate( i2( JIJKU ) )
allocate( i3( JIJKU ) )
allocate( gnegt( JIU,JJU,JKU ) )
allocate( zw ( JIU,JJU,JKU ) )
#else
!Pin positions in the pools of MNH memory
CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_NUCLEATION 1' )
CALL MNH_MEM_GET( i1, JIJKU )
CALL MNH_MEM_GET( i2, JIJKU )
CALL MNH_MEM_GET( i3, JIJKU )
CALL MNH_MEM_GET( gnegt, JIU,JJU,JKU )
CALL MNH_MEM_GET( zw , JIU,JJU,JKU )
#endif
!$acc data present( i1, i2, i3, gnegt, zw )
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HIN', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HIN', prvs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HIN', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
!
! compute the temperature and the pressure
!
PT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
!$acc kernels
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
PT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** ( XRD / XCPD )
#else
!$mnh_do_concurrent ( JI=1:JIU,JJ=1:JJU,JK=1:JKU)
PT(JI,JJ,JK) = PTHT(JI,JJ,JK) * BR_POW( PPABST(JI,JJ,JK) / XP00, XRD / XCPD )
!$mnh_end_do()
#endif
!
!$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
!$acc end kernels
#ifndef MNH_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
#ifndef MNH_OPENACC
ALLOCATE(ZRVT(INEGT))
ALLOCATE(ZCIT(INEGT))
ALLOCATE(ZZT(INEGT))
ALLOCATE(ZPRES(INEGT))
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
#else
!Pin positions in the pools of MNH memory
CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_NUCLEATION 2' )
CALL MNH_MEM_GET( ZRVT, INEGT )
CALL MNH_MEM_GET( ZCIT, INEGT )
CALL MNH_MEM_GET( ZZT, INEGT )
CALL MNH_MEM_GET( ZPRES, INEGT )
CALL MNH_MEM_GET( ZZW, INEGT )
CALL MNH_MEM_GET( ZUSW, INEGT )
CALL MNH_MEM_GET( ZSSI, INEGT )
#endif
!$acc data present( zrvt, zcit, zzt, zpres, zzw, zusw, zssi )
!$acc kernels
!$mnh_do_concurrent ( 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))
!$mnh_end_do()
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
!$mnh_do_concurrent ( JL=1:INEGT )
ZZW(JL) = EXP( XALPI - XBETAI/ZZT(JL) - XGAMI*LOG(ZZT(JL) ) ) ! es_i
!$mnh_end_do()
#else
!$mnh_do_concurrent ( JL=1:INEGT )
ZZW(JL) = BR_EXP( XALPI - XBETAI/ZZT(JL) - XGAMI*BR_LOG(ZZT(JL) ) ) ! es_i
!$mnh_end_do()
#endif
!$mnh_do_concurrent ( JL=1:INEGT )
ZZW(JL) = MIN(ZPRES(JL)/2., ZZW(JL)) ! safety limitation
ZSSI(JL) = ZRVT(JL)*( ZPRES(JL)-ZZW(JL) ) / ( (XMV/XMD) * ZZW(JL) ) - 1.0
! Supersaturation over ice
!$mnh_end_do()
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
!$mnh_do_concurrent ( JL=1:INEGT )
ZUSW(JL) = EXP( XALPW - XBETAW/ZZT(JL) - XGAMW*LOG(ZZT(JL) ) ) ! es_w
ZUSW(JL) = MIN(ZPRES(JL)/2.,ZUSW(JL)) ! safety limitation
ZUSW(JL) = ( ZUSW(JL)/ZZW(JL) )*( (ZPRES(JL)-ZZW(JL))/(ZPRES(JL)-ZUSW(JL)) ) - 1.0
! Supersaturation of saturated water vapor over ice
!$mnh_end_do()
#else
!$mnh_do_concurrent ( JL=1:INEGT )
ZUSW(JL) = BR_EXP( XALPW - XBETAW/ZZT(JL) - XGAMW*BR_LOG(ZZT(JL) ) ) ! es_w
ZUSW(JL) = MIN(ZPRES(JL)/2.,ZUSW(JL)) ! safety limitation
ZUSW(JL) = ( ZUSW(JL)/ZZW(JL) )*( (ZPRES(JL)-ZZW(JL))/(ZPRES(JL)-ZUSW(JL)) ) - 1.0
! Supersaturation of saturated water vapor over ice
!$mnh_end_do()
#endif
!
!* 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 )
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 )
END WHERE
ZZW(:) = ZZW(:) - ZCIT(:)
IF( MAXVAL(ZZW(:)) > 0.0 ) THEN
!$mnh_do_concurrent ( JL=1:INEGT )
ZZW(JL) = 0.0
ZSSI(JL) = MIN( ZSSI(JL), ZUSW(JL) ) ! limitation of SSi according to SSw=0
IF ( (ZZT(JL)<XTT-5.0) .AND. (ZSSI(JL)>0.0) ) THEN
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
ZZW(JL) = XNU20 * EXP( XALPHA2*ZSSI(JL)-XBETA2 )
#else
ZZW(JL) = XNU20 * BR_EXP( XALPHA2*ZSSI(JL)-XBETA2 )
#endif
END IF
!$mnh_end_do()
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
!$mnh_do_concurrent ( JL=1:INEGT )
IF ( (ZZT(JL)<=XTT-2.0) .AND. (ZZT(JL)>=XTT-5.0) .AND. (ZSSI(JL)>0.0) ) THEN
ZZW(JL) = MAX( XNU20 * EXP( -XBETA2 ),XNU10 * EXP( -XBETA1*(ZZT(JL)-XTT) ) * &
( ZSSI(JL)/ZUSW(JL) )**XALPHA1 )
END IF
!$mnh_end_do() ! CONCURRENT
#else
!$mnh_do_concurrent ( JL=1:INEGT )
IF ( (ZZT(JL)<=XTT-2.0) .AND. (ZZT(JL)>=XTT-5.0) .AND. (ZSSI(JL)>0.0) ) THEN
ZZW(JL) = MAX( XNU20 * BR_EXP( -XBETA2 ),XNU10 * BR_EXP( -XBETA1*(ZZT(JL)-XTT) ) * &
BR_POW( ZSSI(JL)/ZUSW(JL),XALPHA1 ) )
END IF
!$mnh_end_do() ! CONCURRENT
#endif
! WARNING COMPILER BUG NVHPC20.X/3 <-> if array syntaxe ZZW(1:INEGT) = ZZW(1:INEGT)
!$mnh_do_concurrent ( JL=1:INEGT )
ZZW(JL) = ZZW(JL) - ZCIT(JL)
!$mnh_end_do()
#ifndef MNH_COMPILER_NVHPC
ZZWMAX = MAXVAL(ZZW(1:INEGT))
!$acc end kernels
#else
!$acc end kernels
ZZWMAX = 0.0
!$acc parallel reduction(max:ZZWMAX)
!$mnh_do_concurrent( JL=1:INEGT)
ZZWMAX = MAX(ZZWMAX,ZZW(JL))
!$mnh_end_do()
!$acc end parallel
#endif
IF( ZZWMAX > 0.0 ) THEN
!$acc kernels
!
!* 3.1.2 update the r_i and r_v mixing ratios
!
ZZW(:) = MIN( ZZW(:),50.E3 ) ! limitation provisoire a 50 l^-1
!
!$mnh_do_concurrent ( JL=1:INEGT )
ZZW(JL) = MIN( ZZW(JL),50.E3 ) ! limitation provisoire a 50 l^-1
!$mnh_end_do()
ZW(:,:,:) = 0.0
DO JL=1, INEGT
!$mnh_do_concurrent ( JL=1:INEGT )
ZW(I1(JL), I2(JL), I3(JL)) = ZZW( JL )
END DO
!$mnh_end_do()
ZW(:,:,:) = MAX( ZW(:,:,:) ,0.0 ) *XMNU0/(PRHODREF(:,:,:)*PTSTEP)
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(:) )
!$mnh_do_concurrent ( JL=1:INEGT )
ZZW(JL) = MAX( ZZW(JL)+ZCIT(JL),ZCIT(JL) )
!$mnh_end_do()
PCIT(:,:,:) = MAX( PCIT(:,:,:), 0.0 )
DO JL=1, INEGT
!$mnh_do_concurrent ( 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
!$mnh_end_do()
!$acc end kernels
END IF
!$acc end data
#ifndef MNH_OPENACC
DEALLOCATE(ZSSI)
DEALLOCATE(ZUSW)
DEALLOCATE(ZZW)
......@@ -167,13 +342,37 @@ IF( INEGT >= 1 ) THEN
DEALLOCATE(ZZT)
DEALLOCATE(ZCIT)
DEALLOCATE(ZRVT)
#else
!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
CALL MNH_MEM_RELEASE( 'RAIN_ICE_NUCLEATION 2' )
#endif
END IF
!
!* 3.1.3 budget storage
!
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HIN', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HIN', prvs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HIN', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"RAIN_ICE_NUCLEATION end:PCIT")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_NUCLEATION end:PTHS")
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_NUCLEATION end:PRVS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_NUCLEATION end:PRIS")
!Check all OUT arrays
CALL MPPDB_CHECK(PT,"RAIN_ICE_NUCLEATION end:PT")
END IF
#ifndef MNH_OPENACC
deallocate (i1, i2, i3, gnegt, zw )
#else
!Release all memory allocated with MNH_MEM_GET calls since beginning of subroutine
CALL MNH_MEM_RELEASE( 'RAIN_ICE_NUCLEATION 1' )
#endif
!$acc end data
!$acc end data
END SUBROUTINE RAIN_ICE_NUCLEATION
......
src/PHYEX/micro/rain_ice_sedimentation_split.f90
+ 48
− 10
View file @ f70e2f17
......@@ -55,8 +55,6 @@ USE MODI_BITREP
USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
USE MODI_GAMMA, ONLY: GAMMA
#if defined(MNH_COMPILER_CCE) && defined(MNH_BITREP_OMP)
!$mnh_undef(LOOP)
!$mnh_undef(OPENACC)
......@@ -155,7 +153,7 @@ LOGICAL :: GKRR_7,GSEDIC
!
! IN variables
!
!$acc data present_crm( PDZZ, PRHODREF, PPABST, PTHT, PRHODJ, PRCT, PRRT, PRIT, PRST, PRGT, &
!$acc data present( PDZZ, PRHODREF, PPABST, PTHT, PRHODJ, PRCT, PRRT, PRIT, PRST, PRGT, &
!$acc & PSEA, PTOWN, PRHT, &
!
! INOUT variables
......@@ -170,6 +168,32 @@ LOGICAL :: GKRR_7,GSEDIC
! !$acc & copyin( XFSEDC, XLBC, XLBEXC )
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(PDZZ,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PDZZ")
CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRHODREF")
CALL MPPDB_CHECK(PPABST,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PPABST")
CALL MPPDB_CHECK(PTHT,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PTHT")
CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRHODJ")
CALL MPPDB_CHECK(PRCT,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRCT")
CALL MPPDB_CHECK(PRRT,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRRT")
CALL MPPDB_CHECK(PRIT,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRIT")
CALL MPPDB_CHECK(PRST,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRST")
CALL MPPDB_CHECK(PRGT,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRGT")
IF (PRESENT(PSEA)) CALL MPPDB_CHECK(PSEA,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PSEA")
IF (PRESENT(PTOWN)) CALL MPPDB_CHECK(PTOWN,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PTOWN")
IF (PRESENT(PRHT)) CALL MPPDB_CHECK(PRHT,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRHT")
!Check all INOUT arrays
CALL MPPDB_CHECK(PINPRC,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PINPRC")
CALL MPPDB_CHECK(PINDEP,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PINDEP")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRCS")
CALL MPPDB_CHECK(PRRS,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRRS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRIS")
CALL MPPDB_CHECK(PRSS,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRSS")
CALL MPPDB_CHECK(PRGS,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRGS")
IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE_SEDIMENTATION_SPLIT beg:PRHS")
END IF
IIU = size(PRCS, 1 )
IJU = size(PRCS, 2 )
IKU = size(PRCS, 3 )
......@@ -313,13 +337,10 @@ IF ( GPRESENT_PFPR ) PFPR(:,:,:,:) = 0.
!
!* 1. Parameters for cloud sedimentation
!
!$acc end kernels
IF ( OSEDIC ) THEN
ZTMP1 = 0.5 * GAMMA( XNUC + 1.0 / XALPHAC ) / ( GAMMA( XNUC ) )
ZTMP2 = 0.5 * GAMMA( XNUC2 + 1.0 / XALPHAC2 ) / ( GAMMA( XNUC2 ) )
END IF
!$acc kernels
IF ( OSEDIC ) THEN
IF ( GPRESENT_PSEA ) THEN
!$mnh_do_concurrent( JI=1:IIU , JJ=1:IJU )
ZOMPSEA (JI,JJ) = 1.-PSEA(JI,JJ)
......@@ -336,13 +357,11 @@ IF ( OSEDIC ) THEN
ZRAY (JI,JJ,JK) = ZTMP4_2D(JI,JJ)
!$mnh_end_do()
ELSE
ZTMP3 = MAX(1.,ZTMP1)
!$mnh_expand_array(JI=1:IIU , JJ=1:IJU , JK=KKTB:KKTE)
ZLBC (:,:,:) = XLBC(1)
ZFSEDC (:,:,:) = XFSEDC(1)
ZCONC3D(:,:,:) = XCONC_LAND
ZTMP3 = MAX(1.,ZTMP1)
ZRAY (:,:,:) = ZTMP3
!$mnh_end_expand_array()
END IF
END IF
!
......@@ -701,6 +720,25 @@ IF (ODEPOSC) THEN
if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
END IF
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PINPRC,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRC")
CALL MPPDB_CHECK(PINDEP,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINDEP")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PRCS")
CALL MPPDB_CHECK(PRRS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PRRS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PRIS")
CALL MPPDB_CHECK(PRSS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PRSS")
CALL MPPDB_CHECK(PRGS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PRGS")
IF (PRESENT(PRHS)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PRHS")
!Check all OUT arrays
CALL MPPDB_CHECK(PINPRR,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRR")
CALL MPPDB_CHECK(PINPRS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRS")
CALL MPPDB_CHECK(PINPRG,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRG")
CALL MPPDB_CHECK(PINPRR3D,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRR3D")
IF (PRESENT(PINPRH)) CALL MPPDB_CHECK(PRHS,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRH")
IF (PRESENT(PFPR)) CALL MPPDB_CHECK(PFPR,"RAIN_ICE_SEDIMENTATION_SPLIT end:PFPR")
END IF
!$acc end data
#ifndef MNH_OPENACC
......
src/PHYEX/micro/rain_ice_slow.f90
+ 251
− 67
View file @ f70e2f17
!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC Copyright 1995-2022 CNRS, Meteo-France and Universite Paul Sabatier
!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.
......@@ -30,11 +30,22 @@ use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, l
NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, &
tbudgets
use MODD_CST, only: XALPI, XBETAI, XCI, XCPV, XGAMI, XLSTT, XMNH_HUGE_12_LOG, XP00, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XCEXVT, XLBDAS_MAX, XLBEXG, XLBEXS, XLBG, XLBS, XRTMIN, XBS
use MODD_RAIN_ICE_DESCR, only: XCEXVT, XLBDAS_MAX, XLBEXG, XLBEXS, XLBG, XLBS, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA3, XBCRIAUTI, XBETA3, XCOLEXIS, XCRIAUTI, &
XEX0DEPG, XEX0DEPS, XEX1DEPG, XEX1DEPS, XEXIAGGS, XFIAGGS, XHON, XSCFAC, XTEXAUTI, XTIMAUTI
use mode_budget, only: Budget_store_add
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
use mode_mppdb
#if defined(MNH_BITREP) || defined(MNH_BITREP_OMP)
USE MODI_BITREP
#endif
#ifdef MNH_COMPILER_CCE
!$mnh_undef(LOOP)
!$mnh_undef(OPENACC)
#endif
IMPLICIT NONE
!
......@@ -70,25 +81,98 @@ REAL, DIMENSION(:), intent(OUT) :: PLBDAG ! Slope parameter of the g
!
!* 0.2 declaration of local variables
!
REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
REAL, DIMENSION(size(PRHODREF)) :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
real, dimension(size(plsfact)) :: zz_diff
#ifndef MNH_OPENACC
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
REAL, DIMENSION(:), ALLOCATABLE :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
real, dimension(:), ALLOCATABLE :: zz_diff
#else
LOGICAL, DIMENSION(:), pointer, contiguous :: GWORK
REAL, DIMENSION(:), pointer, contiguous :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
REAL, DIMENSION(:), pointer, contiguous :: ZZW ! Work array
real, dimension(:), pointer, contiguous :: zz_diff
#endif
!
INTEGER :: JL,JLU
!-------------------------------------------------------------------------------
zz_diff(:) = plsfact(:) - plvfact(:)
!
! IN variables
!
!$acc data present( OMICRO, PRHODREF, PRCT, PRRT, PRIT, PRST, PRGT, &
!$acc & PRHODJ, PZT, PPRES, PLSFACT, PLVFACT, PSSI, &
!
! INOUT variables
!
!$acc & PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PTHS, &
!
! OUT variables
!
!$acc & PAI, PCJ, PKA, PDV, PLBDAS, PLBDAG )
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(OMICRO,"RAIN_ICE_SLOW beg:OMICRO")
CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE_SLOW beg:PRHODREF")
CALL MPPDB_CHECK(PRCT,"RAIN_ICE_SLOW beg:PRCT")
CALL MPPDB_CHECK(PRRT,"RAIN_ICE_SLOW beg:PRRT")
CALL MPPDB_CHECK(PRIT,"RAIN_ICE_SLOW beg:PRIT")
CALL MPPDB_CHECK(PRST,"RAIN_ICE_SLOW beg:PRST")
CALL MPPDB_CHECK(PRGT,"RAIN_ICE_SLOW beg:PRGT")
CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE_SLOW beg:PRHODJ")
CALL MPPDB_CHECK(PZT,"RAIN_ICE_SLOW beg:PZT")
CALL MPPDB_CHECK(PPRES,"RAIN_ICE_SLOW beg:PPRES")
CALL MPPDB_CHECK(PLSFACT,"RAIN_ICE_SLOW beg:PLSFACT")
CALL MPPDB_CHECK(PLVFACT,"RAIN_ICE_SLOW beg:PLVFACT")
CALL MPPDB_CHECK(PSSI,"RAIN_ICE_SLOW beg:PSSI")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_SLOW beg:PRVS")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_SLOW beg:PRCS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_SLOW beg:PRIS")
CALL MPPDB_CHECK(PRSS,"RAIN_ICE_SLOW beg:PRSS")
CALL MPPDB_CHECK(PRGS,"RAIN_ICE_SLOW beg:PRGS")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_SLOW beg:PTHS")
END IF
!
JLU = size(PRHODREF)
!
#ifndef MNH_OPENACC
ALLOCATE( GWORK (JLU) )
ALLOCATE( ZZW (JLU) )
ALLOCATE( ZCRIAUTI(JLU) )
ALLOCATE( zz_diff (size(PLSFACT)) )
#else
!Pin positions in the pools of MNH memory
CALL MNH_MEM_POSITION_PIN( 'RAIN_ICE_SLOW' )
CALL MNH_MEM_GET( GWORK, JLU )
CALL MNH_MEM_GET( ZZW, JLU )
CALL MNH_MEM_GET( ZCRIAUTI, JLU )
CALL MNH_MEM_GET( zz_diff, SIZE(PLSFACT) )
!$acc data present( gwork, zzw, zcriauti, zz_diff )
#endif
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
!$acc kernels
zz_diff(:) = plsfact(:) - plvfact(:)
ZZW(:) = 0.0
WHERE( (PZT(:)<XTT-35.0) .AND. (PRCT(:)>XRTMIN(2)) .AND. (PRCS(:)>0.) )
ZZW(:) = MIN( PRCS(:),XHON*PRHODREF(:)*PRCT(:) &
*EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(PZT(:)-XTT)-XBETA3) ) )
! *EXP( XALPHA3*(PZT(:)-XTT)-XBETA3 ) )
PRIS(:) = PRIS(:) + ZZW(:)
PRCS(:) = PRCS(:) - ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RCHONI))
ENDWHERE
GWORK(:) = PZT(:)<XTT-35.0 .AND. PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.
!$mnh_do_concurrent( JL=1:JLU )
IF ( GWORK(JL) ) THEN
ZZW(JL) = MIN( PRCS(JL),XHON*PRHODREF(JL)*PRCT(JL) &
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
*EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(PZT(JL)-XTT)-XBETA3) ) )
#else
*BR_EXP(MIN(XMNH_HUGE_12_LOG, XALPHA3*(PZT(JL)-XTT)-XBETA3) ) )
#endif
PRIS(JL) = PRIS(JL) + ZZW(JL)
PRCS(JL) = PRCS(JL) - ZZW(JL)
PTHS(JL) = PTHS(JL) + ZZW(JL) * zz_diff(JL) ! f(L_f*(RCHONI))
END IF
!$mnh_end_do()
!$acc end kernels
if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', &
Unpack( zzw(:) * zz_diff(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
......@@ -99,13 +183,18 @@ real, dimension(size(plsfact)) :: zz_diff
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
ZZW(:) = 0.0
WHERE( (PZT(:)<XTT-35.0) .AND. (PRRT(:)>XRTMIN(3)) .AND. (PRRS(:)>0.) )
ZZW(:) = MIN( PRRS(:),PRRT(:)* PINVTSTEP )
PRGS(:) = PRGS(:) + ZZW(:)
PRRS(:) = PRRS(:) - ZZW(:)
PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RRHONG))
ENDWHERE
!$acc kernels
!$mnh_do_concurrent (JL=1:JLU)
ZZW(JL) = 0.0
GWORK(JL) = PZT(JL)<XTT-35.0 .AND. PRRT(JL)>XRTMIN(3) .AND. PRRS(JL)>0.
IF( GWORK(JL) )THEN
ZZW(JL) = MIN( PRRS(JL),PRRT(JL)* PINVTSTEP )
PRGS(JL) = PRGS(JL) + ZZW(JL)
PRRS(JL) = PRRS(JL) - ZZW(JL)
PTHS(JL) = PTHS(JL) + ZZW(JL) * zz_diff(JL) ! f(L_f*(RRHONG))
ENDIF
!$mnh_end_do()
!$acc end kernels
if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', &
Unpack( zzw(:) * zz_diff(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
......@@ -116,17 +205,32 @@ real, dimension(size(plsfact)) :: zz_diff
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
!
!$acc kernels
PKA(:) = 2.38E-2 + 0.0071E-2 * ( PZT(:) - XTT ) ! k_a
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
PDV(:) = 0.211E-4 * (PZT(:)/XTT)**1.94 * (XP00/PPRES(:)) ! D_v
#else
!$mnh_do_concurrent ( JL=1:JLU )
PDV(JL) = 0.211E-4 * BR_POW(PZT(JL)/XTT,1.94) * (XP00/PPRES(JL)) ! D_v
!$mnh_end_do()
#endif
!
!* 3.4.1 compute the thermodynamical function A_i(T,P)
!* and the c^prime_j (in the ventilation factor)
!
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
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
!$mnh_do_concurrent ( JL=1:JLU )
PAI(JL) = BR_EXP( XALPI - XBETAI/PZT(JL) - XGAMI*BR_LOG(PZT(JL) ) ) ! es_i
PAI(JL) = BR_P2( XLSTT + (XCPV-XCI)*(PZT(JL)-XTT) ) / (PKA(JL)*XRV*BR_P2(PZT(JL))) &
+ ( XRV*PZT(JL) ) / (PDV(JL)*PAI(JL))
PCJ(JL) = XSCFAC * BR_POW(PRHODREF(JL),0.3) / BR_POW( 1.718E-5+0.0049E-5*(PZT(JL)-XTT) , 0.5)
!$mnh_end_do()
#endif
!
!* 3.4.2 compute the riming-conversion of r_c for r_i production: RCAUTI
!
......@@ -141,24 +245,37 @@ real, dimension(size(plsfact)) :: zz_diff
!
!* 3.4.3 compute the deposition on r_s: RVDEPS
!
WHERE ( PRST(:)>0.0 )
PLBDAS(:) = MIN( XLBDAS_MAX, &
XLBS*( PRHODREF(:)*MAX( PRST(:),XRTMIN(5) ) )**XLBEXS )
END WHERE
GWORK(:) = PRST(:)>0.0
!$mnh_do_concurrent( JL=1:JLU )
IF ( GWORK(JL) ) THEN
PLBDAS(JL) = MIN( XLBDAS_MAX, &
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
XLBS*( PRHODREF(JL)*MAX( PRST(JL),XRTMIN(5) ) )**XLBEXS )
#else
XLBS*BR_POW( PRHODREF(JL)*MAX( PRST(JL),XRTMIN(5) ),XLBEXS ) )
#endif
ELSE
PLBDAS(JL) = 0.
END IF
!$mnh_end_do() ! CONCURRENT
ZZW(:) = 0.0
WHERE ( (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0) )
#if defined(REPRO48)
ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
GWORK(:) = (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0)
!$mnh_do_concurrent ( JL=1:JLU )
IF ( GWORK(JL) ) THEN
ZZW(JL) = ( PSSI(JL)/(PRHODREF(JL)*PAI(JL)) ) * &
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
( X0DEPS*PLBDAS(JL)**XEX0DEPS + X1DEPS*PCJ(JL)*PLBDAS(JL)**XEX1DEPS )
#else
ZZW(:) = ( PRST(:) * PLBDAS(:)**XBS * PSSI(:)/PAI(:) ) * &
( X0DEPS*BR_POW(PLBDAS(JL),XEX0DEPS) + X1DEPS*PCJ(JL)*BR_POW(PLBDAS(JL),XEX1DEPS) )
#endif
( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
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
ZZW(JL) = MIN( PRVS(JL),ZZW(JL) )*(0.5+SIGN(0.5,ZZW(JL))) &
- MIN( PRSS(JL),ABS(ZZW(JL)) )*(0.5-SIGN(0.5,ZZW(JL)))
PRSS(JL) = PRSS(JL) + ZZW(JL)
PRVS(JL) = PRVS(JL) - ZZW(JL)
PTHS(JL) = PTHS(JL) + ZZW(JL)*PLSFACT(JL)
END IF
!$mnh_end_do()
!$acc end kernels
if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', &
Unpack( zzw(:) * plsfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
......@@ -169,20 +286,27 @@ real, dimension(size(plsfact)) :: zz_diff
!
!* 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) )
ZZW(:) = MIN( PRIS(:),XFIAGGS * EXP( XCOLEXIS*(PZT(:)-XTT) ) &
* PRIT(:) &
#if defined(REPRO48)
* PLBDAS(:)**XEXIAGGS &
* PRHODREF(:)**(-XCEXVT) )
GWORK(:) = PRIT(:)>XRTMIN(4) .AND. PRST(:)>XRTMIN(5) .AND. PRIS(:)>0.0
!$mnh_do_concurrent ( JL=1:JLU )
IF ( GWORK(JL) ) THEN
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
ZZW(JL) = MIN( PRIS(JL),XFIAGGS * EXP( XCOLEXIS*(PZT(JL)-XTT) ) &
* PRIT(JL) &
* PLBDAS(JL)**XEXIAGGS &
* PRHODREF(JL)**(-XCEXVT) )
#else
* PRST(:) * PLBDAS(:)**(XBS+XEXIAGGS) &
* PRHODREF(:)**(-XCEXVT+1) )
ZZW(JL) = MIN( PRIS(JL),XFIAGGS * BR_EXP( XCOLEXIS*(PZT(JL)-XTT) ) &
* PRIT(JL) &
* BR_POW(PLBDAS(JL),XEXIAGGS) &
* BR_POW(PRHODREF(JL),-XCEXVT) )
#endif
PRSS(:) = PRSS(:) + ZZW(:)
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
PRSS(JL) = PRSS(JL) + ZZW(JL)
PRIS(JL) = PRIS(JL) - ZZW(JL)
END IF
!$mnh_end_do() ! CONCURRENT
!$acc end kernels
if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', &
Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
......@@ -191,15 +315,31 @@ real, dimension(size(plsfact)) :: zz_diff
!
!* 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
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PZT(:)-XTT)+XBCRIAUTI))
#else
!$mnh_do_concurrent ( JL=1:JLU )
ZCRIAUTI(JL)=MIN(XCRIAUTI, BR_POW(10.,XACRIAUTI*(PZT(JL)-XTT)+XBCRIAUTI) )
!$mnh_end_do()
#endif
ZZW(:) = 0.0
WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRIS(:)>0.0) )
ZZW(:) = MIN( PRIS(:),XTIMAUTI * EXP( XTEXAUTI*(PZT(:)-XTT) ) &
* MAX( PRIT(:)-ZCRIAUTI(:),0.0 ) )
PRSS(:) = PRSS(:) + ZZW(:)
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
GWORK(:) = PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0
!$mnh_do_concurrent( JL=1:JLU )
IF ( GWORK(JL) ) THEN
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
ZZW(JL) = MIN( PRIS(JL),XTIMAUTI * EXP( XTEXAUTI*(PZT(JL)-XTT) ) &
* MAX( PRIT(JL)-ZCRIAUTI(JL),0.0 ) )
#else
ZZW(JL) = MIN( PRIS(JL),XTIMAUTI * BR_EXP( XTEXAUTI*(PZT(JL)-XTT) ) &
* MAX( PRIT(JL)-ZCRIAUTI(JL),0.0 ) )
#endif
PRSS(JL) = PRSS(JL) + ZZW(JL)
PRIS(JL) = PRIS(JL) - ZZW(JL)
!!END WHERE
END IF
!$mnh_end_do()
!$acc end kernels
if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', &
Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
......@@ -209,19 +349,37 @@ real, dimension(size(plsfact)) :: zz_diff
!* 3.4.6 compute the deposition on r_g: RVDEPG
!
!
WHERE ( PRGT(:)>0.0 )
PLBDAG(:) = XLBG*( PRHODREF(:)*MAX( PRGT(:),XRTMIN(6) ) )**XLBEXG
END WHERE
!$acc kernels
GWORK(:) = PRGT(:)>0.0
!$mnh_do_concurrent ( JL=1:JLU )
IF ( GWORK(JL) ) THEN
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
PLBDAG(JL) = XLBG*( PRHODREF(JL)*MAX( PRGT(JL),XRTMIN(6) ) )**XLBEXG
#else
PLBDAG(JL) = XLBG*BR_POW( PRHODREF(JL)*MAX( PRGT(JL),XRTMIN(6) ), XLBEXG)
#endif
ELSE
PLBDAG(JL) = 0.
END IF
!$mnh_end_do() ! CONCURRENT
ZZW(:) = 0.0
WHERE ( (PRGT(:)>XRTMIN(6)) .AND. (PRGS(:)>0.0) )
ZZW(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
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
GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0
!$mnh_do_concurrent ( JL=1:JLU )
IF ( GWORK(JL) ) THEN
ZZW(JL) = ( PSSI(JL)/(PRHODREF(JL)*PAI(JL)) ) * &
#if !defined(MNH_BITREP) && !defined(MNH_BITREP_OMP)
( X0DEPG*PLBDAG(JL)**XEX0DEPG + X1DEPG*PCJ(JL)*PLBDAG(JL)**XEX1DEPG )
#else
( X0DEPG*BR_POW(PLBDAG(JL),XEX0DEPG) + X1DEPG*PCJ(JL)*BR_POW(PLBDAG(JL),XEX1DEPG) )
#endif
ZZW(JL) = MIN( PRVS(JL),ZZW(JL) )*(0.5+SIGN(0.5,ZZW(JL))) &
- MIN( PRGS(JL),ABS(ZZW(JL)) )*(0.5-SIGN(0.5,ZZW(JL)))
PRGS(JL) = PRGS(JL) + ZZW(JL)
PRVS(JL) = PRVS(JL) - ZZW(JL)
PTHS(JL) = PTHS(JL) + ZZW(JL)*PLSFACT(JL)
END IF
!$mnh_end_do() ! CONCURRENT
!$acc end kernels
if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', &
Unpack( zzw(:) * plsfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
......@@ -229,6 +387,32 @@ real, dimension(size(plsfact)) :: zz_diff
Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_SLOW end:PRVS")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_SLOW end:PRCS")
CALL MPPDB_CHECK(PRIS,"RAIN_ICE_SLOW end:PRIS")
CALL MPPDB_CHECK(PRSS,"RAIN_ICE_SLOW end:PRSS")
CALL MPPDB_CHECK(PRGS,"RAIN_ICE_SLOW end:PRGS")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_SLOW end:PTHS")
!Check all OUT arrays
CALL MPPDB_CHECK(PAI,"RAIN_ICE_SLOW end:PAI")
CALL MPPDB_CHECK(PCJ,"RAIN_ICE_SLOW end:PCJ")
CALL MPPDB_CHECK(PKA,"RAIN_ICE_SLOW end:PKA")
CALL MPPDB_CHECK(PDV,"RAIN_ICE_SLOW end:PDV")
CALL MPPDB_CHECK(PLBDAS,"RAIN_ICE_SLOW end:PLBDAS")
CALL MPPDB_CHECK(PLBDAG,"RAIN_ICE_SLOW end:PLBDAG")
END IF
!$acc end data
#ifdef MNH_OPENACC
!Release all memory allocated with MNH_MEM_GET calls since last call to MNH_MEM_POSITION_PIN
CALL MNH_MEM_RELEASE( 'RAIN_ICE_SLOW' )
#endif
!$acc end data
END SUBROUTINE RAIN_ICE_SLOW
END MODULE MODE_RAIN_ICE_SLOW
src/PHYEX/micro/rain_ice_warm.f90
+ 45
− 1
View file @ f70e2f17
......@@ -84,6 +84,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
!PW: PUSW could be a purely local variable?
REAL, DIMENSION(:), INTENT(INOUT) :: PUSW ! Undersaturation over water
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!
......@@ -112,7 +113,7 @@ LOGICAL :: GCSUBG_RR_EVAP ! temporary variable for OpenCC character limitation (
!
! IN variables
!
!$acc data present_crm( OMICRO, K1, K2, K3, PRHODREF, PRVT, PRCT, PRRT, &
!$acc data 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, &
......@@ -124,6 +125,39 @@ LOGICAL :: GCSUBG_RR_EVAP ! temporary variable for OpenCC character limitation (
! OUT variables
!
!NONE
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK(OMICRO,"RAIN_ICE_WARM beg:OMICRO")
CALL MPPDB_CHECK(PRHODREF,"RAIN_ICE_WARM beg:PRHODREF")
CALL MPPDB_CHECK(PRVT,"RAIN_ICE_WARM beg:PRVT")
CALL MPPDB_CHECK(PRCT,"RAIN_ICE_WARM beg:PRCT")
CALL MPPDB_CHECK(PRRT,"RAIN_ICE_WARM beg:PRRT")
CALL MPPDB_CHECK(PHLC_HCF,"RAIN_ICE_WARM beg:PHLC_HCF")
CALL MPPDB_CHECK(PHLC_LCF,"RAIN_ICE_WARM beg:PHLC_LCF")
CALL MPPDB_CHECK(PHLC_HRC,"RAIN_ICE_WARM beg:PHLC_HRC")
CALL MPPDB_CHECK(PHLC_LRC,"RAIN_ICE_WARM beg:PHLC_LRC")
CALL MPPDB_CHECK(PRHODJ,"RAIN_ICE_WARM beg:PRHODJ")
CALL MPPDB_CHECK(PPRES,"RAIN_ICE_WARM beg:PPRES")
CALL MPPDB_CHECK(PZT,"RAIN_ICE_WARM beg:PZT")
CALL MPPDB_CHECK(PLBDAR,"RAIN_ICE_WARM beg:PLBDAR")
CALL MPPDB_CHECK(PLBDAR_RF,"RAIN_ICE_WARM beg:PLBDAR_RF")
CALL MPPDB_CHECK(PLVFACT,"RAIN_ICE_WARM beg:PLVFACT")
CALL MPPDB_CHECK(PCJ,"RAIN_ICE_WARM beg:PCJ")
CALL MPPDB_CHECK(PKA,"RAIN_ICE_WARM beg:PKA")
CALL MPPDB_CHECK(PDV,"RAIN_ICE_WARM beg:PDV")
CALL MPPDB_CHECK(PRF,"RAIN_ICE_WARM beg:PRF")
CALL MPPDB_CHECK(PCF,"RAIN_ICE_WARM beg:PCF")
CALL MPPDB_CHECK(PTHT,"RAIN_ICE_WARM beg:PTHT")
CALL MPPDB_CHECK(PTHLT,"RAIN_ICE_WARM beg:PTHLT")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_WARM beg:PRVS")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_WARM beg:PRCS")
CALL MPPDB_CHECK(PRRS,"RAIN_ICE_WARM beg:PRRS")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_WARM beg:PTHS")
CALL MPPDB_CHECK(PUSW,"RAIN_ICE_WARM beg:PUSW")
CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE_WARM beg:PEVAP3D")
END IF
!
JLU = size(PRHODREF)
!
......@@ -387,6 +421,16 @@ IF (CSUBG_RR_EVAP=='CLFR') GCSUBG_RR_EVAP=.true.
END DO
!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_WARM end:PRVS")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_WARM end:PRCS")
CALL MPPDB_CHECK(PRRS,"RAIN_ICE_WARM end:PRRS")
CALL MPPDB_CHECK(PTHS,"RAIN_ICE_WARM end:PTHS")
CALL MPPDB_CHECK(PUSW,"RAIN_ICE_WARM end:PUSW")
CALL MPPDB_CHECK(PEVAP3D,"RAIN_ICE_WARM end:PEVAP3D")
END IF
!$acc end data
#ifdef MNH_OPENACC
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme