From 0bce585c69590d1716e764b53068b6db95a5cd2b Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 17 Mar 2017 15:07:31 +0100
Subject: [PATCH] Philippe 17/03/2017: optimisation/simplification + small bug
corrections
---
src/MNH/rain_ice.f90 | 479 +++++++++++++------------------------------
1 file changed, 145 insertions(+), 334 deletions(-)
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index 54ce81608..d143f4fce 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -424,12 +424,6 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
!
REAL, DIMENSION(:), ALLOCATABLE &
:: ZRHODREF, & ! RHO Dry REFerence
- ZRHODREFC,& ! RHO Dry REFerence
- ZRHODREFR,& ! RHO Dry REFerence
- ZRHODREFI,& ! RHO Dry REFerence
- ZRHODREFS,& ! RHO Dry REFerence
- ZRHODREFG,& ! RHO Dry REFerence
- ZRHODREFH,& ! RHO Dry REFerence
ZRHODJ, & ! RHO times Jacobian
ZZT, & ! Temperature
ZPRES, & ! Pressure
@@ -450,13 +444,7 @@ REAL, DIMENSION(:), ALLOCATABLE &
ZKA, & ! Thermal conductivity of the air
ZDV, & ! Diffusivity of water vapor in the air
ZSIGMA_RC,& ! Standard deviation of rc at time t
- ZCF, & ! Cloud fraction
- ZCC, & ! terminal velocity
- ZFSEDC1D, & ! For cloud sedimentation
- ZWLBDC, & ! Slope parameter of the droplet distribution
- ZCONC, & ! Concentration des aerosols
- ZRAY1D, & ! Mean radius
- ZWLBDA ! Libre parcours moyen
+ ZCF ! Cloud fraction
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
REAL :: ZTIMAUTIC, ZTHRC, ZTHRH
REAL :: ZINVTSTEP
@@ -473,12 +461,12 @@ INTEGER :: JL ! and PACK intrinsics
!$acc & ZWSED,ZWSEDW1,ZWSEDW2,ZCONC_TMP,ZT,ZRAY,ZLBC,ZFSEDC, &
!$acc & ZRVT,ZRCT,ZRRT,ZRIT,ZRST,ZRGT,ZRHT,ZCIT, &
!$acc & ZRVS,ZRCS,ZRRS,ZRIS,ZRSS,ZRGS,ZRHS,ZTHS, &
-!$acc & ZRHODREF,ZRHODREFR,ZRHODREFI,ZRHODREFS,ZRHODREFG,ZRHODREFH, &
+!$acc & ZRHODREF, &
!$acc & ZRHODJ,ZZT,ZPRES,ZZW,ZLSFACT,ZLVFACT, &
!$acc & ZUSW,ZSSI,ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH, &
!$acc & ZAI,ZCJ,ZKA,ZDV,ZZW1,ZRTMIN) &
-!$acc & device_resident(ZCRIAUTI,ZEXNREF,ZRDRYG,ZRWETG,ZSIGMA_RC,ZCF,ZCC, &
-!$acc & ZFSEDC1D,ZWLBDC,ZCONC,ZRAY1D,ZWLBDA,I1,I2,I3)
+!$acc & device_resident(ZCRIAUTI,ZEXNREF,ZRDRYG,ZRWETG,ZSIGMA_RC,ZCF, &
+!$acc & I1,I2,I3)
!
#ifdef _OPENACC
PRINT *,'OPENACC: RAIN_ICE being implemented'
@@ -493,7 +481,7 @@ END IF
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
+! -----------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB=KKA+JPVEXT*KKL
@@ -507,7 +495,7 @@ ZINVTSTEP=1./PTSTEP
!
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
-! --------------------------------------
+! --------------------------------------
!
CALL RAIN_ICE_NUCLEATION
!
@@ -663,7 +651,7 @@ IF( IMICRO >= 0 ) THEN
!
!
!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES
-! --------------------------------------
+! --------------------------------------
!
!* 3.1 compute the slope parameter Lbda_r
!
@@ -949,27 +937,19 @@ INTEGER , DIMENSION(SIZE(GSEDIMS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
INTEGER , DIMENSION(SIZE(GSEDIMI)) :: II1,II2,II3 ! Used to replace the COUNT
INTEGER , DIMENSION(SIZE(GSEDIMG)) :: IG1,IG2,IG3 ! Used to replace the COUNT
INTEGER , DIMENSION(SIZE(GSEDIMH)) :: IH1,IH2,IH3 ! Used to replace the COUNT
-INTEGER :: ILENALLOCC,ILENALLOCR,ILENALLOCI,ILENALLOCS,ILENALLOCG,ILENALLOCH
-INTEGER :: ILISTLENC,ILISTLENR,ILISTLENI,ILISTLENS,ILISTLENG,ILISTLENH
-INTEGER, ALLOCATABLE :: ILISTR(:),ILISTC(:),ILISTI(:),ILISTS(:),ILISTG(:),ILISTH(:)
-! Optimization for NEC
-!INTEGER, SAVE :: IOLDALLOCC = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
-!INTEGER, SAVE :: IOLDALLOCR = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
-!INTEGER, SAVE :: IOLDALLOCI = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
-!INTEGER, SAVE :: IOLDALLOCS = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
-!INTEGER, SAVE :: IOLDALLOCG = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
-!INTEGER, SAVE :: IOLDALLOCH = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
-INTEGER, SAVE :: IOLDALLOCC = 6000
-INTEGER, SAVE :: IOLDALLOCR = 6000
-INTEGER, SAVE :: IOLDALLOCI = 6000
-INTEGER, SAVE :: IOLDALLOCS = 6000
-INTEGER, SAVE :: IOLDALLOCG = 6000
-INTEGER, SAVE :: IOLDALLOCH = 6000
-!
+REAL :: ZRHODREFLOC ! RHO Dry REFerence
+REAL :: ZRSLOC,ZRTLOC ! Intermediary variables
+REAL :: ZWLBDC ! Slope parameter of the droplet distribution
+REAL :: ZCONC ! Concentration of aerosols
+REAL :: ZZTLOC ! Temperature
+REAL :: ZPRESLOC ! Pressure
+REAL :: ZRAY1D ! Mean radius
+REAL :: ZFSEDC1D ! For cloud sedimentation
+REAL :: ZWLBDA ! Mean freepath
+REAL :: ZCC ! Terminal velocity
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
!$acc declare device_resident(IC1,IC2,IC3,IR1,IR2,IR3,IS1,IS2,IS3, &
-!$acc & II1,II2,II3,IG1,IG2,IG3,IH1,IH2,IH3, &
-!$acc & ILISTR,ILISTC,ILISTI,ILISTS,ILISTG,ILISTH) &
+!$acc & II1,II2,II3,IG1,IG2,IG3,IH1,IH2,IH3) &
!$acc & create(ZCONC3D)
!-------------------------------------------------------------------------------
!
@@ -1030,13 +1010,6 @@ GSEDIMS(:,:,:) = .FALSE.
GSEDIMG(:,:,:) = .FALSE.
IF ( KRR == 7 ) GSEDIMH(:,:,:) = .FALSE.
!
-ILENALLOCR = 0
-IF (OSEDIC) ILENALLOCC = 0
-ILENALLOCI = 0
-ILENALLOCS = 0
-ILENALLOCG = 0
-IF ( KRR == 7 ) ILENALLOCH = 0
-!
! ZPiS = Specie i source creating during the current time step
! PRiS = Source of the previous time step
!
@@ -1107,77 +1080,46 @@ DO JN = 1 , KSPLITR
!
!* 2.1 for cloud
!
- IF (OSEDIC) THEN
!$acc kernels
+ IF (OSEDIC) THEN
ZWSED(:,:,:) = 0.
IF( JN==1 ) PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
-!$acc end kernels
- IF( ISEDIMC >= 1 ) THEN
- IF ( ISEDIMC .GT. ILENALLOCC ) THEN
- IF ( ILENALLOCC .GT. 0 ) THEN
- DEALLOCATE (ZRCS, ZRHODREFC, ILISTC,ZWLBDC,ZCONC,ZRCT, &
- ZZT,ZPRES,ZRAY1D,ZFSEDC1D,ZWLBDA,ZCC )
- END IF
- ILENALLOCC = MAX (IOLDALLOCC, 2*ISEDIMC )
- IOLDALLOCC = ILENALLOCC
- ALLOCATE(ZRCS(ILENALLOCC), ZRHODREFC(ILENALLOCC), ILISTC(ILENALLOCC), &
- ZWLBDC(ILENALLOCC), ZCONC(ILENALLOCC), ZRCT(ILENALLOCC), ZZT(ILENALLOCC), &
- ZPRES(ILENALLOCC), ZRAY1D(ILENALLOCC), ZFSEDC1D(ILENALLOCC), &
- ZWLBDA(ILENALLOCC), ZCC(ILENALLOCC) )
- END IF
-!
-!$acc kernels
- DO JL=1,ISEDIMC
- ZRCS(JL) = PRCS(IC1(JL),IC2(JL),IC3(JL))
- ZRHODREFC(JL) = PRHODREF(IC1(JL),IC2(JL),IC3(JL))
- ZWLBDC(JL) = ZLBC(IC1(JL),IC2(JL),IC3(JL))
- ZCONC(JL) = ZCONC3D(IC1(JL),IC2(JL),IC3(JL))
- ZRCT(JL) = PRCT(IC1(JL),IC2(JL),IC3(JL))
- ZZT(JL) = PTHT(IC1(JL),IC2(JL),IC3(JL))
- ZPRES(JL) = PPABST(IC1(JL),IC2(JL),IC3(JL))
- ZRAY1D(JL) = ZRAY(IC1(JL),IC2(JL),IC3(JL))
- ZFSEDC1D(JL) = ZFSEDC(IC1(JL),IC2(JL),IC3(JL))
- END DO
-!
- ILISTLENC = 0
- DO JL=1,ISEDIMC
- IF( ZRCS(JL) .GT. ZRTMIN(2) ) THEN
- ILISTLENC = ILISTLENC + 1
- ILISTC(ILISTLENC) = JL
- END IF
- END DO
-!$acc end kernels
!
-!$acc kernels
- DO JJ = 1, ILISTLENC
- JL = ILISTC(JJ)
- IF (ZRCS(JL) .GT. ZRTMIN(2) .AND. ZRCT(JL) .GT. XRTMIN(2)) THEN
- ZWLBDC(JL) = ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL))
+ DO JL=1,ISEDIMC
+ ZRSLOC = PRCS(IC1(JL),IC2(JL),IC3(JL))
+ ZRTLOC = PRCT(IC1(JL),IC2(JL),IC3(JL))
+ IF (ZRSLOC .GT. ZRTMIN(2) .AND. ZRTLOC .GT. XRTMIN(2)) THEN
+ ZRHODREFLOC = PRHODREF(IC1(JL),IC2(JL),IC3(JL))
+ ZWLBDC = ZLBC (IC1(JL),IC2(JL),IC3(JL))
+ ZCONC = ZCONC3D (IC1(JL),IC2(JL),IC3(JL))
+ ZZTLOC = PTHT (IC1(JL),IC2(JL),IC3(JL))
+ ZPRESLOC = PPABST (IC1(JL),IC2(JL),IC3(JL))
+ ZRAY1D = ZRAY (IC1(JL),IC2(JL),IC3(JL))
+ ZFSEDC1D = ZFSEDC (IC1(JL),IC2(JL),IC3(JL))
+ ZWLBDC = ZWLBDC * ZCONC / (ZRHODREFLOC * ZRTLOC)
#ifndef MNH_BITREP
- ZWLBDC(JL) = ZWLBDC(JL)**XLBEXC
+ ZWLBDC = ZWLBDC**XLBEXC
#else
- ZWLBDC(JL) = BR_POW(ZWLBDC(JL),XLBEXC)
+ ZWLBDC = BR_POW(ZWLBDC,XLBEXC)
#endif
- ZRAY1D(JL) = ZRAY1D(JL) / ZWLBDC(JL) !! ZRAY : mean diameter=M(1)/2
+ ZRAY1D = ZRAY1D / ZWLBDC !! ZRAY : mean diameter=M(1)/2
#ifndef MNH_BITREP
- ZZT(JL) = ZZT(JL) * (ZPRES(JL)/XP00)**(XRD/XCPD)
+ ZZTLOC = ZZTLOC * (ZPRESLOC/XP00)**(XRD/XCPD)
#else
- ZZT(JL) = ZZT(JL) * BR_POW(ZPRES(JL)/XP00,XRD/XCPD)
+ ZZTLOC = ZZTLOC * BR_POW(ZPRESLOC/XP00,XRD/XCPD)
#endif
- ZWLBDA(JL) = 6.6E-8*(101325./ZPRES(JL))*(ZZT(JL)/293.15)
- ZCC(JL) = XCC*(1.+1.26*ZWLBDA(JL)/ZRAY1D(JL)) !! XCC modified for cloud
+ ZWLBDA = 6.6E-8*(101325./ZPRESLOC)*(ZZTLOC/293.15)
+ ZCC = XCC*(1.+1.26*ZWLBDA/ZRAY1D) !! XCC modified for cloud
#ifndef MNH_BITREP
- ZWSED (IC1(JL),IC2(JL),IC3(JL))= ZRHODREFC(JL)**(-XCEXVT +1 ) * &
- ZWLBDC(JL)**(-XDC)*ZCC(JL)*ZFSEDC1D(JL) * ZRCS(JL)
+ ZWSED (IC1(JL),IC2(JL),IC3(JL))= ZRHODREFLOC**(-XCEXVT +1 ) * &
+ ZWLBDC**(-XDC)*ZCC*ZFSEDC1D * ZRSLOC
#else
- ZWSED (IC1(JL),IC2(JL),IC3(JL))= BR_POW(ZRHODREFC(JL),-XCEXVT +1) * &
- BR_POW(ZWLBDC(JL),-XDC)*ZCC(JL)*ZFSEDC1D(JL) * ZRCS(JL)
+ ZWSED (IC1(JL),IC2(JL),IC3(JL))= BR_POW(ZRHODREFLOC,-XCEXVT +1) * &
+ BR_POW(ZWLBDC,-XDC)*ZCC*ZFSEDC1D * ZRSLOC
#endif
- END IF
- END DO
-!$acc end kernels
- END IF
-!$acc kernels
+ END IF
+ END DO
+!
DO JK = IKTB , IKTE
PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
END DO
@@ -1185,280 +1127,159 @@ DO JN = 1 , KSPLITR
IF( JN==KSPLITR ) THEN
PRCS(:,:,:) = PRCS(:,:,:) * ZINVTSTEP
END IF
-!$acc end kernels
END IF
+!acc end kernels
!
!* 2.2 for rain
!
-!$acc kernels
+!acc kernels
IF( JN==1 ) PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
ZWSED(:,:,:) = 0.
-!$acc end kernels
- IF( ISEDIMR >= 1 ) THEN
- IF ( ISEDIMR .GT. ILENALLOCR ) THEN
- IF ( ILENALLOCR .GT. 0 ) THEN
- DEALLOCATE (ZRRS, ZRHODREFR, ILISTR)
- END IF
- ILENALLOCR = MAX (IOLDALLOCR, 2*ISEDIMR )
- IOLDALLOCR = ILENALLOCR
- ALLOCATE(ZRRS(ILENALLOCR), ZRHODREFR(ILENALLOCR), ILISTR(ILENALLOCR))
- END IF
-!
-!acc kernels present(PRRS,PRHODREF,ZRTMIN,ILISTR,ZWSED,IR1,IR2,IR3,ZRRS,ZRHODREFR) copyin(XEXSEDR) default(none)
-!$acc kernels
- DO JL=1,ISEDIMR
- ZRRS(JL) = PRRS(IR1(JL),IR2(JL),IR3(JL))
- ZRHODREFR(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
- END DO
!
- ILISTLENR = 0
- DO JL=1,ISEDIMR
- IF( ZRRS(JL) .GT. ZRTMIN(3) ) THEN
- ILISTLENR = ILISTLENR + 1
- ILISTR(ILISTLENR) = JL
- END IF
- END DO
-!$acc end kernels
-!$acc kernels present(ILISTR,ZWSED,IR1,IR2,IR3,ZRRS,ZRHODREFR) copyin(XEXSEDR) default(none)
- DO JJ = 1, ILISTLENR
- JL = ILISTR(JJ)
+ DO JL=1,ISEDIMR
+ ZRSLOC = PRRS(IR1(JL),IR2(JL),IR3(JL))
+ IF( ZRSLOC .GT. ZRTMIN(3) ) THEN
+ ZRHODREFLOC = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
#ifndef MNH_BITREP
- ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * ZRRS(JL)**XEXSEDR * &
- ZRHODREFR(JL)**(XEXSEDR-XCEXVT)
+ ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * ZRSLOC**XEXSEDR * &
+ ZRHODREFLOC**(XEXSEDR-XCEXVT)
#else
- ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * BR_POW(ZRRS(JL),XEXSEDR) * &
- BR_POW(ZRHODREFR(JL),XEXSEDR-XCEXVT)
+ ZWSED (IR1(JL),IR2(JL),IR3(JL))= XFSEDR * BR_POW(ZRSLOC,XEXSEDR) * &
+ BR_POW(ZRHODREFLOC,XEXSEDR-XCEXVT)
#endif
- END DO
-!$acc end kernels
- END IF
-!$acc kernels
+ END IF
+ END DO
+!
DO JK = IKTB , IKTE
PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
END DO
- PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
+ PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,IKB) /XRHOLW/KSPLITR
PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSED(:,:,1:IKT)/XRHOLW/KSPLITR
IF ( JN==KSPLITR ) THEN
PRRS(:,:,:) = PRRS(:,:,:) * ZINVTSTEP
END IF
-!$acc end kernels
+!acc end kernels
!
!* 2.3 for pristine ice
!
-!$acc kernels
+!acc kernels
IF( JN==1 ) PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
ZWSED(:,:,:) = 0.
-!$acc end kernels
- IF( ISEDIMI >= 1 ) THEN
- IF ( ISEDIMI .GT. ILENALLOCI ) THEN
- IF ( ILENALLOCI .GT. 0 ) THEN
- DEALLOCATE (ZRIS, ZRHODREFI, ILISTI)
- END IF
- ILENALLOCI = MAX (IOLDALLOCI, 2*ISEDIMI )
- IOLDALLOCI = ILENALLOCI
- ALLOCATE(ZRIS(ILENALLOCI), ZRHODREFI(ILENALLOCI), ILISTI(ILENALLOCI))
- END IF
!
-!$acc kernels
- DO JL=1,ISEDIMI
- ZRIS(JL) = PRIS(II1(JL),II2(JL),II3(JL))
- ZRHODREFI(JL) = PRHODREF(II1(JL),II2(JL),II3(JL))
- END DO
-!
- ILISTLENI = 0
- DO JL=1,ISEDIMI
- IF( ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7 )) THEN ! limitation of the McF&H formula
- ILISTLENI = ILISTLENI + 1
- ILISTI(ILISTLENI) = JL
- END IF
- END DO
-!$acc end kernels
-!$acc kernels
- DO JJ = 1, ILISTLENI
- JL = ILISTI(JJ)
+ DO JL=1,ISEDIMI
+ ZRSLOC = PRIS(II1(JL),II2(JL),II3(JL))
+ IF( ZRSLOC .GT. MAX(ZRTMIN(4),1.0E-7 )) THEN ! limitation of the McF&H formula
+ ZRHODREFLOC = PRHODREF(II1(JL),II2(JL),II3(JL))
#ifndef MNH_BITREP
- ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRIS(JL) * &
- ZRHODREFI(JL)**(1.0-XCEXVT) * & ! McF&H
- MAX( 0.05E6,-0.15319E6-0.021454E6* &
- ALOG(ZRHODREFI(JL)*ZRIS(JL)) )**XEXCSEDI
+ ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRSLOC * &
+ ZRHODREFLOC**(1.0-XCEXVT) * & ! McF&H
+ MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(ZRHODREFLOC*ZRSLOC) )**XEXCSEDI
#else
- ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRIS(JL) * &
- BR_POW(ZRHODREFI(JL),1.0-XCEXVT) * & ! McF&H
- BR_POW(MAX( 0.05E6,-0.15319E6-0.021454E6* &
- BR_LOG(ZRHODREFI(JL)*ZRIS(JL)) ),XEXCSEDI)
+ ZWSED (II1(JL),II2(JL),II3(JL))= XFSEDI * ZRSLOC * &
+ BR_POW(ZRHODREFLOC,1.0-XCEXVT) * & ! McF&H
+ BR_POW(MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ BR_LOG(ZRHODREFLOC*ZRSLOC) ),XEXCSEDI)
#endif
- END DO
-!$acc end kernels
+ END IF
+ END DO
+!
+ DO JK = IKTB , IKTE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ IF( JN==KSPLITR ) THEN
+ PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
END IF
-!$acc kernels
- DO JK = IKTB , IKTE
- PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- IF( JN==KSPLITR ) THEN
- PRIS(:,:,:) = PRIS(:,:,:) * ZINVTSTEP
- END IF
-!$acc end kernels
+!acc end kernels
!
!* 2.4 for aggregates/snow
!
-!$acc kernels
+!acc kernels
IF( JN==1 ) PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
ZWSED(:,:,:) = 0.
-!$acc end kernels
- IF( ISEDIMS >= 1 ) THEN
- IF ( ISEDIMS .GT. ILENALLOCS ) THEN
- IF ( ILENALLOCS .GT. 0 ) THEN
- DEALLOCATE (ZRSS, ZRHODREFS, ILISTS)
- END IF
- ILENALLOCS = MAX (IOLDALLOCS, 2*ISEDIMS )
- IOLDALLOCS = ILENALLOCS
- ALLOCATE(ZRSS(ILENALLOCS), ZRHODREFS(ILENALLOCS), ILISTS(ILENALLOCS))
- END IF
!
-!$acc kernels
- DO JL=1,ISEDIMS
- ZRSS(JL) = PRSS(IS1(JL),IS2(JL),IS3(JL))
- ZRHODREFS(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
- END DO
-!
- ILISTLENS = 0
- DO JL=1,ISEDIMS
- IF( ZRSS(JL) .GT. ZRTMIN(5) ) THEN
- ILISTLENS = ILISTLENS + 1
- ILISTS(ILISTLENS) = JL
- END IF
- END DO
-!$acc end kernels
-!$acc kernels present(ILISTS,IS1,IS2,IS3,ZRSS,ZRHODREFS,ZWSED) copyin(XEXSEDS) default(none)
- DO JJ = 1, ILISTLENS
- JL = ILISTS(JJ)
+ DO JL=1,ISEDIMS
+ ZRSLOC = PRSS(IS1(JL),IS2(JL),IS3(JL))
+ IF( ZRSLOC .GT. ZRTMIN(5) ) THEN
+ ZRHODREFLOC = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
#ifndef MNH_BITREP
- ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * ZRSS(JL)**XEXSEDS * &
- ZRHODREFS(JL)**(XEXSEDS-XCEXVT)
+ ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * ZRSLOC**XEXSEDS * &
+ ZRHODREFLOC**(XEXSEDS-XCEXVT)
#else
- ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * BR_POW(ZRSS(JL),XEXSEDS) * &
- BR_POW(ZRHODREFS(JL),XEXSEDS-XCEXVT)
+ ZWSED (IS1(JL),IS2(JL),IS3(JL))= XFSEDS * BR_POW(ZRSLOC,XEXSEDS) * &
+ BR_POW(ZRHODREFLOC,XEXSEDS-XCEXVT)
#endif
- END DO
-!$acc end kernels
+ END IF
+ END DO
+!
+ DO JK = IKTB , IKTE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
END IF
-!$acc kernels
- DO JK = IKTB , IKTE
- PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
- IF( JN==KSPLITR ) THEN
- PRSS(:,:,:) = PRSS(:,:,:) * ZINVTSTEP
- END IF
-!$acc end kernels
+!acc end kernels
!
!* 2.5 for graupeln
!
-!$acc kernels
+!acc kernels
ZWSED(:,:,:) = 0.
IF( JN==1 ) PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
-!$acc end kernels
- IF( ISEDIMG >= 1 ) THEN
- IF ( ISEDIMG .GT. ILENALLOCG ) THEN
- IF ( ILENALLOCG .GT. 0 ) THEN
- DEALLOCATE (ZRGS, ZRHODREFG, ILISTG)
- END IF
- ILENALLOCG = MAX (IOLDALLOCG, 2*ISEDIMG )
- IOLDALLOCG = ILENALLOCG
- ALLOCATE(ZRGS(ILENALLOCG), ZRHODREFG(ILENALLOCG), ILISTG(ILENALLOCG))
- END IF
-!
-!$acc kernels
- DO JL=1,ISEDIMG
- ZRGS(JL) = PRGS(IG1(JL),IG2(JL),IG3(JL))
- ZRHODREFG(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
- END DO
!
- ILISTLENG = 0
- DO JL=1,ISEDIMG
- IF( ZRGS(JL) .GT. ZRTMIN(6) ) THEN
- ILISTLENG = ILISTLENG + 1
- ILISTG(ILISTLENG) = JL
- END IF
- END DO
-!$acc end kernels
-!$acc kernels present(ILISTG,IG1,IG2,IG3,ZRGS,ZRHODREFG,ZWSED) copyin(XEXSEDG) default(none)
- DO JJ = 1, ILISTLENG
- JL = ILISTG(JJ)
+ DO JL=1,ISEDIMG
+ ZRSLOC = PRGS(IG1(JL),IG2(JL),IG3(JL))
+ IF( ZRSLOC .GT. ZRTMIN(6) ) THEN
+ ZRHODREFLOC = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
#ifndef MNH_BITREP
- ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * ZRGS(JL)**XEXSEDG * &
- ZRHODREFG(JL)**(XEXSEDG-XCEXVT)
+ ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * ZRSLOC**XEXSEDG * &
+ ZRHODREFLOC**(XEXSEDG-XCEXVT)
#else
- ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * BR_POW(ZRGS(JL),XEXSEDG) * &
- BR_POW(ZRHODREFG(JL),XEXSEDG-XCEXVT)
+ ZWSED (IG1(JL),IG2(JL),IG3(JL))= XFSEDG * BR_POW(ZRSLOC,XEXSEDG) * &
+ BR_POW(ZRHODREFLOC,XEXSEDG-XCEXVT)
#endif
- END DO
-!$acc end kernels
-END IF
-!$acc kernels
- DO JK = IKTB , IKTE
- PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
- IF( JN==KSPLITR ) THEN
- PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
- END IF
-!$acc end kernels
+ END IF
+ END DO
+!
+ DO JK = IKTB , IKTE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRGS(:,:,:) = PRGS(:,:,:) * ZINVTSTEP
+ END IF
+!acc end kernels
!
!* 2.6 for hail
!
- IF ( KRR == 7 ) THEN
-!$acc kernels
+!acc kernels
+ IF ( KRR == 7 ) THEN
IF( JN==1 ) PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
ZWSED(:,:,:) = 0.
-!$acc end kernels
- IF( ISEDIMH >= 1 ) THEN
- IF ( ISEDIMH .GT. ILENALLOCH ) THEN
- IF ( ILENALLOCH .GT. 0 ) THEN
- DEALLOCATE (ZRHS, ZRHODREFH, ILISTH)
- END IF
- ILENALLOCH = MAX (IOLDALLOCH, 2*ISEDIMH )
- IOLDALLOCH = ILENALLOCH
- ALLOCATE(ZRHS(ILENALLOCH), ZRHODREFH(ILENALLOCH), ILISTH(ILENALLOCH))
- END IF
-!
-!$acc kernels
- DO JL=1,ISEDIMH
- ZRHS(JL) = PRHS(IH1(JL),IH2(JL),IH3(JL))
- ZRHODREFH(JL) = PRHODREF(IH1(JL),IH2(JL),IH3(JL))
- END DO
!
- ILISTLENH = 0
- DO JL=1,ISEDIMH
- IF( ZRHS(JL) .GT. ZRTMIN(7) ) THEN
- ILISTLENH = ILISTLENH + 1
- ILISTH(ILISTLENH) = JL
- END IF
- END DO
-!$acc end kernels
-!$acc kernels present(ILISTH,IH1,IH2,IH3,ZRHS,ZRHODREFH,ZWSED) copyin(XEXSEDH) default(none)
- DO JJ = 1, ILISTLENH
- JL = ILISTH(JJ)
+ DO JL=1,ISEDIMH
+ ZRSLOC = PRHS(IH1(JL),IH2(JL),IH3(JL))
+ IF( ZRSLOC .GT. ZRTMIN(7) ) THEN
+ ZRHODREFLOC = PRHODREF(IH1(JL),IH2(JL),IH3(JL))
#ifndef MNH_BITREP
- ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * ZRHS(JL)**XEXSEDH * &
- ZRHODREFH(JL)**(XEXSEDH-XCEXVT)
+ ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * ZRSLOC**XEXSEDH * &
+ ZRHODREFLOC**(XEXSEDH-XCEXVT)
#else
- ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * BR_POW(ZRHS(JL),XEXSEDH) * &
- BR_POW(ZRHODREFH(JL),XEXSEDH-XCEXVT)
+ ZWSED (IH1(JL),IH2(JL),IH3(JL))= XFSEDH * BR_POW(ZRSLOC,XEXSEDH) * &
+ BR_POW(ZRHODREFLOC,XEXSEDH-XCEXVT)
#endif
- END DO
-!$acc end kernels
+ END IF
+ END DO
+!
+ DO JK = IKTB , IKTE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
+ END DO
+ PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
+ IF( JN==KSPLITR ) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
END IF
-!$acc kernels
- DO JK = IKTB , IKTE
- PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+KKL)-ZWSED(:,:,JK))
- END DO
- PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
- IF( JN==KSPLITR ) THEN
- PRHS(:,:,:) = PRHS(:,:,:) * ZINVTSTEP
- END IF
+ END IF ! KRR==7
!$acc end kernels
- END IF
!
END DO
!$acc update self(PRRS,PRSS,PRGS,PRIS)
@@ -1468,16 +1289,6 @@ IF (KRR==7) THEN
END IF
#endif
!
-IF (OSEDIC) THEN
- IF (ILENALLOCC .GT. 0) DEALLOCATE (ZRCS, ZRHODREFC, &
- ILISTC,ZWLBDC,ZCONC,ZRCT, ZZT,ZPRES,ZRAY1D,ZFSEDC1D, ZWLBDA,ZCC)
-END IF
-IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZRHODREFR,ZRRS,ILISTR)
-IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZRHODREFI,ZRIS,ILISTI)
-IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZRHODREFS,ZRSS,ILISTS)
-IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZRHODREFG,ZRGS,ILISTG)
-IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH)
-!
!* 2.3 budget storage
!
IF (LBUDGET_RC .AND. OSEDIC) THEN
@@ -2070,7 +1881,7 @@ 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)
+!$acc declare device_resident(I1,I2,I3)
!
!-------------------------------------------------------------------------------
!
@@ -4001,7 +3812,7 @@ INTEGER, INTENT(OUT) :: IC ! Count
!
!* 0.2 declaration of local variables
!
-INTEGER :: JI,JJ,JK,IC
+INTEGER :: JI,JJ,JK
!
!-------------------------------------------------------------------------------
!
@@ -4072,7 +3883,7 @@ INTEGER, INTENT(OUT) :: IC ! Count
!
!* 0.2 declaration of local variables
!
-INTEGER :: JI,JJ,IC
+INTEGER :: JI,JJ
!
!-------------------------------------------------------------------------------
!
@@ -4137,7 +3948,7 @@ INTEGER, INTENT(OUT) :: IC ! Count
!
!* 0.2 declaration of local variables
!
-INTEGER :: JI,IC
+INTEGER :: JI
!
!-------------------------------------------------------------------------------
!
--
GitLab