From e22b0c4862d394649e9ed951f8a35bca023e3bcf Mon Sep 17 00:00:00 2001
From: Juan Escobar <escj@aero.obs-mip.fr>
Date: Wed, 8 Jul 2020 11:15:06 +0200
Subject: [PATCH] Juan 08/07/2020: more PGI BUG correction -> use MNH_ALLOCATE
---
src/MNH/turb.f90 | 43 +++++++++++++++++++++++++++++++++++++++----
1 file changed, 39 insertions(+), 4 deletions(-)
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index dbe932a9a..f8bdd312d 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -2216,9 +2216,11 @@ REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: &
ZDTHLDZ,ZDRTDZ, &!dtheta_l/dz, drt_dz used for computing the stablity
! ! criterion
ZETHETA,ZEMOIST !coef ETHETA and EMOIST
+INTEGER :: IZWORK2D,IZDTHLDZ,IZDRTDZ,IZETHETA,IZEMOIST
!
#ifdef MNH_OPENACC
REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZTMP1_DEVICE,ZTMP2_DEVICE
+INTEGER :: IZTMP1_DEVICE,IZTMP2_DEVICE
#endif
INTEGER :: JIU,JJU,JKU
!----------------------------------------------------------------------------
@@ -2247,17 +2249,26 @@ JJU = size(pthlt, 2 )
JKU = size(pthlt, 3 )
!-------------------------------------------------------------------------------
-allocate( ZWORK2D(SIZE(PLM,1),SIZE(PLM,2)) )
+#ifndef MNH_OPENACC
+allocate( ZWORK2D(JIU,JJU) )
allocate( ZDTHLDZ(JIU,JJU,JKU) )
allocate( ZDRTDZ (JIU,JJU,JKU) )
allocate( ZETHETA(JIU,JJU,JKU) )
allocate( ZEMOIST(JIU,JJU,JKU) )
+#else
+IZWORK2D = MNH_ALLOCATE_ZT2D( ZWORK2D,JIU,JJU)
+IZDTHLDZ = MNH_ALLOCATE_ZT3D( ZDTHLDZ,JIU,JJU,JKU)
+IZDRTDZ = MNH_ALLOCATE_ZT3D( ZDRTDZ ,JIU,JJU,JKU)
+IZETHETA = MNH_ALLOCATE_ZT3D( ZETHETA,JIU,JJU,JKU)
+IZEMOIST = MNH_ALLOCATE_ZT3D( ZEMOIST,JIU,JJU,JKU)
+#endif
+
#ifdef MNH_OPENACC
-allocate( ZTMP1_DEVICE(JIU,JJU,JKU) )
-allocate( ZTMP2_DEVICE(JIU,JJU,JKU) )
+IZTMP1_DEVICE = MNH_ALLOCATE_ZT3D( ZTMP1_DEVICE,JIU,JJU,JKU)
+IZTMP2_DEVICE = MNH_ALLOCATE_ZT3D( ZTMP2_DEVICE,JIU,JJU,JKU)
#endif
-!$acc data create( zwork2d, zdthldz, zdrtdz, zetheta, zemoist, &
+!$acc data present(zwork2d, zdthldz, zdrtdz, zetheta, zemoist, &
!$acc & ztmp1_device, ztmp2_device )
!
@@ -2277,6 +2288,10 @@ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
!$acc kernels
PLM(:,:,:) = SQRT( PLM(:,:,:)*ZTMP1_DEVICE )
!$acc end kernels
+ if ( mppdb_initialized ) then
+ call Mppdb_check( ZTMP1_DEVICE , "Dear mid: ZTMP1_DEVICE=Mxf" )
+ call Mppdb_check( plm, "Dear mid:plm" )
+ end if
#endif
ELSE
!PW: "BUG" PGI : results different on CPU and GPU due to the power function
@@ -2292,6 +2307,11 @@ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
!$acc kernels
PLM(:,:,:) = (PLM(:,:,:)*ZTMP1_DEVICE*ZTMP2_DEVICE ) ** (1./3.)
!$acc end kernels
+ if ( mppdb_initialized ) then
+ call Mppdb_check( ZTMP1_DEVICE , "Dear mid: ZTMP1_DEVICE=Mxf" )
+ call Mppdb_check( ZTMP2_DEVICE , "Dear mid: ZTMP2_DEVICE=Myf" )
+ call Mppdb_check( plm, "Dear mid:plm" )
+ end if
#endif
!
#else
@@ -2301,9 +2321,17 @@ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
#else
CALL MXF_DEVICE(PDXX,ZTMP1_DEVICE)
CALL MYF_DEVICE(PDYY,ZTMP2_DEVICE)
+ if ( mppdb_initialized ) then
+ call Mppdb_check( ZTMP1_DEVICE , "Dear mid: ZTMP1_DEVICE=Mxf" )
+ call Mppdb_check( ZTMP2_DEVICE , "Dear mid: ZTMP2_DEVICE=Myf" )
+ call Mppdb_check( plm, "Dear mid1:plm" )
+ end if
!$acc kernels
PLM(:,:,:) = BR_POW( PLM(:,:,:)*ZTMP1_DEVICE *ZTMP2_DEVICE , 1./3. )
!$acc end kernels
+ if ( mppdb_initialized ) then
+ call Mppdb_check( plm, "Dear mid2:plm" )
+ end if
#endif
#endif
END IF
@@ -2404,6 +2432,13 @@ end if
!$acc end data
+#ifndef MNH_OPENACC
+deallocate(zwork2d, zdthldz, zdrtdz, zetheta, zemoist )
+#else
+CALL MNH_REL_ZT3D(izwork2d, izdthldz, izdrtdz, izetheta, izemoist, &
+ iztmp1_device, iztmp2_device )
+#endif
+
!$acc end data
END SUBROUTINE DEAR
--
GitLab