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

Juan 04/01/2021: rain_ice.f90 , for OpenACC , use ZT1D & array routines for...

Juan 04/01/2021: rain_ice.f90 , for OpenACC , use ZT1D & array routines for allocate/manage 1D array
parent 672e8046
No related branches found
No related tags found
No related merge requests found
......@@ -282,6 +282,10 @@ USE MODI_BITREP
#endif
use MODI_BUDGET
USE MODI_ICE4_RAINFR_VERT
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK , ONLY : MNH_ALLOCATE_ZT3D , MNH_REL_ZT3D, MNH_ALLOCATE_ZT1DP , MNH_REL_ZT1D , &
MNH_ALLOCATE_GT3D , MNH_REL_GT3D
#endif
IMPLICIT NONE
!
......@@ -362,31 +366,34 @@ INTEGER :: IKE,IKTE !
INTEGER :: IMICRO
INTEGER, DIMENSION(:), ALLOCATABLE :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
LOGICAL, DIMENSION(:,:,:), ALLOCATABLE &
:: GMICRO ! Test where to compute all processes
LOGICAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS &
:: GMICRO ! Test where to compute all processes
INTEGER :: IGMICRO
REAL :: ZINVTSTEP
REAL :: ZCOEFFRCM
REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t
REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
!
REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
REAL, DIMENSION(:), ALLOCATABLE :: ZTHT ! Potential temperature
REAL, DIMENSION(:), ALLOCATABLE :: ZTHLT ! Liquid potential temperature
!
REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRVT ! Water vapor m.r. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRCT ! Cloud water m.r. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRRT ! Rain water m.r. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRGT ! Graupel m.r. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRHT ! Hail m.r. at t
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZCIT ! Pristine ice conc. at t
INTEGER :: IZRVT,IZRCT,IZRRT,IZRIT,IZRST,IZRGT,IZRHT,IZCIT
!
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRVS ! Water vapor m.r. source
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRCS ! Cloud water m.r. source
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRRS ! Rain water m.r. source
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRIS ! Pristine ice m.r. source
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRSS ! Snow/aggregate m.r. source
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRGS ! Graupel m.r. source
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRHS ! Hail m.r. source
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZTHS ! Theta source
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZTHT ! Potential temperature
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZTHLT ! Liquid potential temperature
INTEGER :: IZRVS,IZRCS,IZRRS,IZRIS,IZRSS,IZRGS,IZRHS,IZTHS,IZTHT,IZTHLT
!
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZRHODREF, & ! RHO Dry REFerence
ZRHODJ, & ! RHO times Jacobian
ZZT, & ! Temperature
ZPRES, & ! Pressure
......@@ -423,9 +430,21 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
ZHLC_LRCLOCAL ! HLCLOUDS : LWC that is Low LWC local in LCF
! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
! = ZHLC_HRC/HCF+ ZHLC_LRC/LCF
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW ! work array
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT ! Temperature
INTEGER :: IZRHODREF,IZZT,IZPRES,IZEXNREF,IZSIGMA_RC,IZCF,IZRF
INTEGER :: IZHLC_HCF,IZHLC_LCF,IZHLC_HRC,IZHLC_LRC,IZHLC_RCMAX
INTEGER :: IZRCRAUTC,IZHLC_HRCLOCAL,IZHLC_LRCLOCAL
INTEGER :: IZZW,IZLSFACT,IZLVFACT,IZUSW,IZSSI,IZLBDAR,IZLBDAR_RF
INTEGER :: IZLBDAS,IZLBDAG,IZLBDAH,IZRDRYG,IZRWETG,IZAI,IZCJ
INTEGER :: IZKA,IZDV,IZRHODJ
!
REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZZW1 ! Work arrays
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZW ! work array
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZT ! Temperature
INTEGER :: IZZW1,IZW,IZT
INTEGER :: IIU,IJU,IKU
!
LOGICAl :: GPDF_SIGM
!
! IN variables
!
......@@ -487,12 +506,23 @@ IF ( KRR == 7 ) THEN
END IF
#endif
IIU = size(PEXNREF, 1 )
IJU = size(PEXNREF, 2 )
IKU = size(PEXNREF, 3 )
ALLOCATE( I1(SIZE(PEXNREF)), I2(SIZE(PEXNREF)), I3(SIZE(PEXNREF)) )
ALLOCATE( GMICRO(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
ALLOCATE( ZW (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
ALLOCATE( ZT (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
!$acc data create( I1, I2, I3, GMICRO, ZW, ZT )
#ifndef MNH_OPENACC
ALLOCATE( GMICRO(IIU,IJU,IKU) )
ALLOCATE( ZW (IIU,IJU,IKU) )
ALLOCATE( ZT (IIU,IJU,IKU) )
#else
IGMICRO = MNH_ALLOCATE_GT3D( GMICRO,IIU,IJU,IKU )
IZW = MNH_ALLOCATE_ZT3D( ZW ,IIU,IJU,IKU )
IZT = MNH_ALLOCATE_ZT3D( ZT ,IIU,IJU,IKU )
#endif
!$acc data create( I1, I2, I3 ) present (GMICRO, ZW, ZT )
!-------------------------------------------------------------------------------
!
......@@ -511,6 +541,7 @@ IKTE=IKT-JPVEXT
!
ZINVTSTEP=1./PTSTEP
!
GPDF_SIGM = ( HSUBG_AUCV == 'PDF ' .AND. CSUBG_PR_PDF == 'SIGM' )
!
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
......@@ -552,6 +583,7 @@ CALL COUNTJV_DEVICE(GMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
#endif
IF( IMICRO >= 0 ) THEN
#ifndef MNH_OPENACC
ALLOCATE(ZRVT(IMICRO))
ALLOCATE(ZRCT(IMICRO))
ALLOCATE(ZRRT(IMICRO))
......@@ -625,19 +657,98 @@ IF( IMICRO >= 0 ) THEN
ELSE
ALLOCATE(ZRHODJ(0))
END IF
#else
IZRVT = MNH_ALLOCATE_ZT1DP(ZRVT,IMICRO)
IZRCT = MNH_ALLOCATE_ZT1DP(ZRCT,IMICRO)
IZRRT = MNH_ALLOCATE_ZT1DP(ZRRT,IMICRO)
IZRIT = MNH_ALLOCATE_ZT1DP(ZRIT,IMICRO)
IZRST = MNH_ALLOCATE_ZT1DP(ZRST,IMICRO)
IZRGT = MNH_ALLOCATE_ZT1DP(ZRGT,IMICRO)
IF ( KRR == 7 ) THEN
IZRHT = MNH_ALLOCATE_ZT1DP(ZRHT,IMICRO)
ELSE
IZRHT = MNH_ALLOCATE_ZT1DP(ZRHT,0)
END IF
IZCIT = MNH_ALLOCATE_ZT1DP(ZCIT,IMICRO)
IZRVS = MNH_ALLOCATE_ZT1DP(ZRVS,IMICRO)
IZRCS = MNH_ALLOCATE_ZT1DP(ZRCS,IMICRO)
IZRRS = MNH_ALLOCATE_ZT1DP(ZRRS,IMICRO)
IZRIS = MNH_ALLOCATE_ZT1DP(ZRIS,IMICRO)
IZRSS = MNH_ALLOCATE_ZT1DP(ZRSS,IMICRO)
IZRGS = MNH_ALLOCATE_ZT1DP(ZRGS,IMICRO)
IF ( KRR == 7 ) THEN
IZRHS = MNH_ALLOCATE_ZT1DP(ZRHS,IMICRO)
ELSE
IZRHS = MNH_ALLOCATE_ZT1DP(ZRHS,0)
END IF
IZTHS = MNH_ALLOCATE_ZT1DP(ZTHS,IMICRO)
IZTHT = MNH_ALLOCATE_ZT1DP(ZTHT,IMICRO)
IZTHLT = MNH_ALLOCATE_ZT1DP(ZTHLT,IMICRO)
IZRHODREF = MNH_ALLOCATE_ZT1DP(ZRHODREF,IMICRO)
IZZT = MNH_ALLOCATE_ZT1DP(ZZT,IMICRO)
IZPRES = MNH_ALLOCATE_ZT1DP(ZPRES,IMICRO)
IZEXNREF = MNH_ALLOCATE_ZT1DP(ZEXNREF,IMICRO)
IZSIGMA_RC = MNH_ALLOCATE_ZT1DP(ZSIGMA_RC,IMICRO)
IZCF = MNH_ALLOCATE_ZT1DP(ZCF,IMICRO)
IZRF = MNH_ALLOCATE_ZT1DP(ZRF,IMICRO)
IZHLC_HCF = MNH_ALLOCATE_ZT1DP(ZHLC_HCF,IMICRO)
IZHLC_LCF = MNH_ALLOCATE_ZT1DP(ZHLC_LCF,IMICRO)
IZHLC_HRC = MNH_ALLOCATE_ZT1DP(ZHLC_HRC,IMICRO)
IZHLC_LRC = MNH_ALLOCATE_ZT1DP(ZHLC_LRC,IMICRO)
IZHLC_RCMAX = MNH_ALLOCATE_ZT1DP(ZHLC_RCMAX,IMICRO)
IZRCRAUTC = MNH_ALLOCATE_ZT1DP(ZRCRAUTC,IMICRO)
IZHLC_HRCLOCAL = MNH_ALLOCATE_ZT1DP(ZHLC_HRCLOCAL,IMICRO)
IZHLC_LRCLOCAL = MNH_ALLOCATE_ZT1DP(ZHLC_LRCLOCAL,IMICRO)
!
IZZW = MNH_ALLOCATE_ZT1DP(ZZW,IMICRO)
IZLSFACT = MNH_ALLOCATE_ZT1DP(ZLSFACT,IMICRO)
IZLVFACT = MNH_ALLOCATE_ZT1DP(ZLVFACT,IMICRO)
IZUSW = MNH_ALLOCATE_ZT1DP(ZUSW,IMICRO)
IZSSI = MNH_ALLOCATE_ZT1DP(ZSSI,IMICRO)
IZLBDAR = MNH_ALLOCATE_ZT1DP(ZLBDAR,IMICRO)
IZLBDAR_RF = MNH_ALLOCATE_ZT1DP(ZLBDAR_RF,IMICRO)
IZLBDAS = MNH_ALLOCATE_ZT1DP(ZLBDAS,IMICRO)
IZLBDAG = MNH_ALLOCATE_ZT1DP(ZLBDAG,IMICRO)
IF ( KRR == 7 ) THEN
IZLBDAH = MNH_ALLOCATE_ZT1DP(ZLBDAH,IMICRO)
ELSE
IZLBDAH = MNH_ALLOCATE_ZT1DP(ZLBDAH,0)
END IF
IZRDRYG = MNH_ALLOCATE_ZT1DP(ZRDRYG,IMICRO)
IZRWETG = MNH_ALLOCATE_ZT1DP(ZRWETG,IMICRO)
IZAI = MNH_ALLOCATE_ZT1DP(ZAI,IMICRO)
IZCJ = MNH_ALLOCATE_ZT1DP(ZCJ,IMICRO)
IZKA = MNH_ALLOCATE_ZT1DP(ZKA,IMICRO)
IZDV = MNH_ALLOCATE_ZT1DP(ZDV,IMICRO)
IF ( KRR == 7 ) THEN
!IZZW1 = MNH_ALLOCATE_ZT1DP(ZZW1(IMICRO,7))
ALLOCATE(ZZW1(IMICRO,7))
ELSE IF( KRR == 6 ) THEN
!IZZW1 = MNH_ALLOCATE_ZT1DP(ZZW1(IMICRO,6))
ALLOCATE(ZZW1(IMICRO,6))
ENDIF
!
IF (LBU_ENABLE .OR. LLES_CALL .OR. LCHECK ) THEN
IZRHODJ = MNH_ALLOCATE_ZT1DP(ZRHODJ,IMICRO)
ELSE
IZRHODJ = MNH_ALLOCATE_ZT1DP(ZRHODJ,0)
END IF
#endif
!$acc data create( ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
!$acc data present( ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
!$acc & ZCIT, ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, ZTHT, ZTHLT, &
!$acc & ZRHODREF, ZZT, ZPRES, ZEXNREF, ZSIGMA_RC, ZCF, ZRF, &
!$acc & ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, ZHLC_RCMAX, ZRCRAUTC, &
!$acc & ZHLC_HRCLOCAL, ZHLC_LRCLOCAL, ZZW, ZLSFACT, ZLVFACT, ZUSW, ZSSI, &
!$acc & ZLBDAR, ZLBDAR_RF, ZLBDAS, ZLBDAG, ZLBDAH, ZRDRYG, ZRWETG, &
!$acc & ZAI, ZCJ, ZKA, ZDV, ZZW1, ZRHODJ )
!$acc & ZAI, ZCJ, ZKA, ZDV, ZRHODJ ) &
!$acc & create ( ZZW1 )
!
!$acc kernels
!$acc loop independent
DO JL=1,IMICRO
!acc loop independent
DO CONCURRENT ( 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))
......@@ -672,7 +783,7 @@ IF( IMICRO >= 0 ) THEN
ENDDO
ENDIF
!
IF ( HSUBG_AUCV == 'PDF ' .AND. CSUBG_PR_PDF == 'SIGM' ) THEN
IF ( GPDF_SIGM ) THEN
!$acc loop independent
DO JL=1,IMICRO
ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL)) * 2.
......@@ -688,7 +799,9 @@ IF( IMICRO >= 0 ) THEN
#ifndef MNH_BITREP
ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
#else
ZZW(:) = BR_EXP( XALPI - XBETAI/ZZT(:) - XGAMI*BR_LOG(ZZT(:) ) )
DO CONCURRENT ( JL=1:IMICRO )
ZZW(JL) = BR_EXP( XALPI - XBETAI/ZZT(JL) - XGAMI*BR_LOG(ZZT(JL) ) )
END DO
#endif
ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
! Supersaturation over ice
......@@ -713,7 +826,7 @@ IF( IMICRO >= 0 ) THEN
!$acc kernels
!Cloud water is entirely in low or high part
!$acc loop independent private(JL)
DO JL=1,IMICRO
DO CONCURRENT ( JL=1:IMICRO )
IF (ZRCT(JL) > ZRCRAUTC(JL)) THEN
ZHLC_HCF(JL) = 1.
ZHLC_LCF(JL) = 0.0
......@@ -1053,11 +1166,9 @@ END DO ! CONCURRENT
!$acc end kernels
!$acc end data
!
!
!
#ifndef MNH_OPENACC
DEALLOCATE(ZZW1)
DEALLOCATE(ZDV)
DEALLOCATE(ZCJ)
......@@ -1109,6 +1220,18 @@ END DO ! CONCURRENT
DEALLOCATE(ZRCRAUTC)
DEALLOCATE(ZHLC_HRCLOCAL)
DEALLOCATE(ZHLC_LRCLOCAL)
#else
DEALLOCATE(ZZW1)
CALL MNH_REL_ZT1D(IZKA,IZDV,IZRHODJ)
CALL MNH_REL_ZT1D(IZLBDAS,IZLBDAG,IZLBDAH,IZRDRYG,IZRWETG,IZAI,IZCJ)
CALL MNH_REL_ZT1D(IZZW,IZLSFACT,IZLVFACT,IZUSW,IZSSI,IZLBDAR,IZLBDAR_RF)
CALL MNH_REL_ZT1D(IZRCRAUTC,IZHLC_HRCLOCAL,IZHLC_LRCLOCAL)
CALL MNH_REL_ZT1D(IZHLC_HCF,IZHLC_LCF,IZHLC_HRC,IZHLC_LRC,IZHLC_RCMAX)
CALL MNH_REL_ZT1D(IZRHODREF,IZZT,IZPRES,IZEXNREF,IZSIGMA_RC,IZCF,IZRF)
CALL MNH_REL_ZT1D(IZRVS,IZRCS,IZRRS,IZRIS,IZRSS,IZRGS,IZRHS,IZTHS,IZTHT,IZTHLT)
CALL MNH_REL_ZT1D(IZRVT,IZRCT,IZRRT,IZRIT,IZRST,IZRGT,IZRHT,IZCIT)
#endif
!
ELSE
!
......@@ -1254,10 +1377,18 @@ IF (MPPDB_INITIALIZED) THEN
IF (PRESENT(PFPR)) CALL MPPDB_CHECK(PFPR,"RAIN_ICE end:PFPR")
END IF
!
! !$acc end data
!$acc end data
DEALLOCATE (I1,I2,I3)
#ifndef MNH_OPENACC
DEALLOCATE ( GMICRO,ZW,ZT )
#else
CALL MNH_REL_GT3D ( IGMICRO )
CALL MNH_REL_ZT3D ( IZW,IZT )
#endif
!$acc end data
!-------------------------------------------------------------------------------
......
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