From 729f5fc972ddd6f3f8bbfec48660aed73798d467 Mon Sep 17 00:00:00 2001 From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr> Date: Mon, 20 Sep 2021 13:05:53 +0200 Subject: [PATCH] Philippe 20/09/2021: OpenACC: force copyout of some counters + remove old compiler bug workarounds --- src/MNH/ice4_fast_rg.f90 | 16 ++++++++++------ src/MNH/ice4_fast_rh.f90 | 18 +++--------------- src/MNH/ice4_fast_rs.f90 | 17 ++++++----------- 3 files changed, 19 insertions(+), 32 deletions(-) diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90 index 80807e30f..94a782ef7 100644 --- a/src/MNH/ice4_fast_rg.f90 +++ b/src/MNH/ice4_fast_rg.f90 @@ -361,6 +361,13 @@ ELSE END WHERE ENDIF + +! !$acc end kernels +! call mppdb_check(PRG_TEND,"ICE4_FAST_RG:PRG_TEND 02") +! !$acc kernels + + + ! Wet and dry collection of rs on graupel (6.2.1) IGDRY = 0 !$acc loop private(IDX) independent @@ -383,7 +390,7 @@ END DO !PW: BUG: this is necessary to get correct results (PGI 18.10, 19.10) ! !$acc update self(GDRY,IGDRY) ! !$acc update self(IGDRY) -IF(JJ==-999) print *,jj +! IF(JJ==-999) print *,jj ! !$acc kernels IF(LDSOFT) THEN !$acc kernels @@ -397,6 +404,7 @@ ELSE PRG_TEND(:, IRSDRYG)=0. PRG_TEND(:, IRSWETG)=0. !$acc end kernels + IF(IGDRY>0)THEN !$acc kernels ! @@ -491,11 +499,7 @@ DO JJ = 1, SIZE(GDRY) END IF END DO !$acc end kernels -!PW: BUG: this is necessary to get correct results (PGI 18.10) -! !$acc update self(GDRY,IGDRY) -! !$acc update self(IGDRY) -! IF(JJ==-999) print *,'PW: IGDRY=',IGDRY,COUNT(GDRY) -! !$acc kernels + IF(LDSOFT) THEN !$acc kernels DO JL=1, ISIZE diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90 index 826ace250..0ffc2293f 100644 --- a/src/MNH/ice4_fast_rh.f90 +++ b/src/MNH/ice4_fast_rh.f90 @@ -303,11 +303,7 @@ DO JJ = 1, SIZE(GWET) END IF END DO !$acc end kernels -!PW: BUG: this is necessary to get correct results (PGI 18.10) -! !$acc update self(GWET,IGWET) -! !$acc update self(IGWET) -! IF(JJ==-999) print *,'PW: IGWET=',IGWET,COUNT(GWET) -! !$acc kernels + IF(LDSOFT) THEN !$acc kernels DO JL=1, ISIZE @@ -412,11 +408,7 @@ DO JJ = 1, SIZE(GWET) END IF END DO !$acc end kernels -!PW: BUG: this is necessary to get correct results (PGI 18.10) -! !$acc update self(GWET,IGWET) -! !$acc update self(IGWET) -! IF(JJ==-999) print *,'PW: IGWET=',IGWET,COUNT(GWET) -! !$acc kernels + IF(LDSOFT) THEN !$acc kernels DO JL=1, ISIZE @@ -528,11 +520,7 @@ DO JJ = 1, SIZE(GWET) END IF END DO !$acc end kernels -!PW: BUG: this is necessary to get correct results (PGI 18.10) -! !$acc update self(GWET,IGWET) -! !$acc update self(IGWET) -! IF(JJ==-999) print *,'PW: IGWET=',IGWET,COUNT(GWET) -! !$acc kernels + IF(LDSOFT) THEN !$acc kernels DO JL=1, ISIZE diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90 index 34b81adff..6b48adced 100644 --- a/src/MNH/ice4_fast_rs.f90 +++ b/src/MNH/ice4_fast_rs.f90 @@ -51,6 +51,8 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG END SUBROUTINE ICE4_FAST_RS END INTERFACE END MODULE MODI_ICE4_FAST_RS + + SUBROUTINE ICE4_FAST_RS(LDSOFT, PCOMPUTE, & &PRHODREF, PLVFACT, PLSFACT, PPRES, & &PDV, PKA, PCJ, & @@ -185,6 +187,7 @@ IF (MPPDB_INITIALIZED) THEN CALL MPPDB_CHECK1D(PA_RG,"ICE4_FAST_RS beg:PA_RG",PRECISION) END IF + ISIZE = Size( PRHODREF ) allocate( i1 ( size( prhodref ) ) ) @@ -202,14 +205,13 @@ allocate( zzw ( size( prhodref ) ) ) allocate( zzw2 ( size( prhodref ) ) ) allocate( zzw6 ( size( prhodref ) ) ) allocate( zfreez_rate ( size( prhodref ) ) ) - ! !$acc data create( I1, IVEC1, IVEC2, GRIM, GACC, ZRIM, ZACC, ZMASK, ZVEC1, ZVEC2, ZVEC3, ZZW, ZZW2, ZZW6, ZFREEZ_RATE ) ! !* 5.0 maximum freezing rate ! -!$acc kernels +!$acc kernels copyout(igrim) DO JL=1, ISIZE ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5)) &PCOMPUTE(JL) @@ -277,10 +279,6 @@ DO JJ = 1, SIZE(GRIM) END IF END DO !$acc end kernels -!PW: BUG: this is necessary to get correct results (PGI 18.10) -! !$acc update self(GRIM,IGRIM) -IF(JJ==-999) print *,'PW: IGRIM=',IGRIM,COUNT(GRIM) -! !$acc kernels ! ! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0) IF(LDSOFT) THEN @@ -400,7 +398,7 @@ ELSE ENDIF ENDIF ! -!$acc kernels +!$acc kernels copyout(igacc) DO JL=1, ISIZE ! More restrictive RIM mask to be used for riming by negative temperature only ZRIM(JL)=ZRIM(JL) * & @@ -444,10 +442,7 @@ DO JJ = 1, SIZE(GACC) END IF END DO !$acc end kernels -!PW: BUG: this is necessary to get correct results (PGI 18.10) -! !$acc update self(GACC,IGACC) -IF(JJ==-999) print *,'PW: IGACC=',IGACC,COUNT(GACC) -! !$acc kernels + IF(LDSOFT) THEN !$acc kernels DO JL=1, ISIZE -- GitLab