From a84e32c80bedb58de2c0338cc0e7aa57710ce000 Mon Sep 17 00:00:00 2001
From: ESCOBAR Juan <escj@nuwa>
Date: Mon, 14 Sep 2020 12:02:05 +0200
Subject: [PATCH] Juan 14/09/2020 : resolved_cloud.f90 , more PGI BUG
correction -> use MNH_ALLOCATE
---
src/MNH/resolved_cloud.f90 | 150 +++++++++++++++++++++++++++----------
1 file changed, 110 insertions(+), 40 deletions(-)
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 56dfb0cc5..5e19a9116 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -325,6 +325,10 @@ USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_SLOW_TERMS
+#ifdef MNH_OPENACC
+USE MODE_MNH_ZWORK , ONLY : MNH_ALLOCATE_ZT3D , MNH_REL_ZT3D, MNH_ALLOCATE_ZT4D , MNH_REL_ZT4D , MNH_ALLOCATE_ZT2D , &
+ MNH_ALLOCATE_GT3D , MNH_REL_GT3D
+#endif
!
IMPLICIT NONE
!
@@ -454,11 +458,18 @@ INTEGER :: IKL
INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: JI,JJ,JK,JL
!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZZ
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT,ZEXN,ZLV,ZLS,ZCPH
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOR
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZDZZ
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZT
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZEXN
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZLV
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZLS
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZCPH
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZCOR
+INTEGER :: IZDZZ,IZT,IZEXN,IZLV,IZLS,IZCPH,IZCOR
+!
! for the correction of negative rv
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZZ
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZZZ
+INTEGER :: IZZZ
! model layer height
REAL :: ZMASSTOT ! total mass for one water category
! including the negative values
@@ -468,18 +479,22 @@ REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
!
INTEGER :: ISVBEG ! first scalar index for microphysics
INTEGER :: ISVEND ! last scalar index for microphysics
-REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVS ! scalar tendency for microphysics only
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLMICRO ! mask to limit computation
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies
+REAL, DIMENSION(:,:,:,:), POINTER , CONTIGUOUS :: ZSVT ! scalar variable for microphysics only
+REAL, DIMENSION(:,:,:,:), POINTER , CONTIGUOUS :: ZSVS ! scalar tendency for microphysics only
+LOGICAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: LLMICRO ! mask to limit computation
+INTEGER :: IZSVT,IZSVS,ILLMICRO
! REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
!
INTEGER :: JMOD, JMOD_IFN
LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
! BVIE work array waiting for PINPRI
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINPRI
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHSSTEP
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRSSTEP
+REAL, DIMENSION(:,:), POINTER , CONTIGUOUS :: ZINPRI
+REAL, DIMENSION(:,:,:), POINTER , CONTIGUOUS :: ZTHSSTEP
+REAL, DIMENSION(:,:,:,:), POINTER , CONTIGUOUS :: ZRSSTEP
+INTEGER :: IZINPRI,IZTHSSTEP,IZRSSTEP
+!
+INTEGER :: JIU,JJU,JKU
!
!------------------------------------------------------------------------------
!
@@ -549,20 +564,40 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PSSPRO,"RESOLVED_CLOUD beg:PSSPRO")
END IF
!
-allocate ( LLMICRO ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZDZZ ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZT ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZEXN ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZLV ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZLS ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZCPH ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZCOR ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZZZ ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZINPRI ( SIZE(PZZ,1), SIZE(PZZ,2) ) )
+JIU = size(PZZ, 1 )
+JJU = size(PZZ, 2 )
+JKU = size(PZZ, 3 )
+!
+#ifndef MNH_OPENACC
+allocate ( LLMICRO ( JIU,JJU,JKU ) )
+allocate ( ZDZZ ( JIU,JJU,JKU ) )
+allocate ( ZT ( JIU,JJU,JKU ) )
+allocate ( ZEXN ( JIU,JJU,JKU ) )
+allocate ( ZLV ( JIU,JJU,JKU ) )
+allocate ( ZLS ( JIU,JJU,JKU ) )
+allocate ( ZCPH ( JIU,JJU,JKU ) )
+allocate ( ZCOR ( JIU,JJU,JKU ) )
+allocate ( ZZZ ( JIU,JJU,JKU ) )
+allocate ( ZINPRI ( JIU,JJU ) )
allocate ( ZTHSSTEP ( SIZE(PTHS,1), SIZE(PTHS,2), SIZE(PTHS,3) ) )
allocate ( ZRSSTEP ( SIZE(PRS,1), SIZE(PRS,2), SIZE(PRS,3), SIZE(PRS,4) ) )
+#else
+ILLMICRO = MNH_ALLOCATE_GT3D ( LLMICRO ,JIU,JJU,JKU )
+IZDZZ = MNH_ALLOCATE_ZT3D ( ZDZZ ,JIU,JJU,JKU )
+IZT = MNH_ALLOCATE_ZT3D ( ZT ,JIU,JJU,JKU )
+IZEXN = MNH_ALLOCATE_ZT3D ( ZEXN ,JIU,JJU,JKU )
+IZLV = MNH_ALLOCATE_ZT3D ( ZLV ,JIU,JJU,JKU )
+IZLS = MNH_ALLOCATE_ZT3D ( ZLS ,JIU,JJU,JKU )
+IZCPH = MNH_ALLOCATE_ZT3D ( ZCPH ,JIU,JJU,JKU )
+IZCOR = MNH_ALLOCATE_ZT3D ( ZCOR ,JIU,JJU,JKU )
+IZZZ = MNH_ALLOCATE_ZT3D ( ZZZ ,JIU,JJU,JKU )
+IZINPRI = MNH_ALLOCATE_ZT2D ( ZINPRI ,JIU,JJU )
+IZTHSSTEP = MNH_ALLOCATE_ZT3D ( ZTHSSTEP , SIZE(PTHS,1), SIZE(PTHS,2), SIZE(PTHS,3) )
+IZRSSTEP = MNH_ALLOCATE_ZT4D ( ZRSSTEP , SIZE(PRS,1), SIZE(PRS,2), SIZE(PRS,3), SIZE(PRS,4) )
+#endif
+
-!$acc data create(LLMICRO,ZDZZ,ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR,ZZZ,ZINPRI,ZTHSSTEP,ZRSSTEP)
+!$acc data present(LLMICRO,ZDZZ,ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR,ZZZ,ZINPRI,ZTHSSTEP,ZRSSTEP)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKA=1
@@ -592,9 +627,14 @@ ELSE
END IF
!
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+#ifndef MNH_OPENACC
ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
ALLOCATE(ZSVS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
-!$acc enter data create(ZSVT,ZSVS)
+#else
+ IZSVT = MNH_ALLOCATE_ZT4D(ZSVT ,SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1 )
+ IZSVS = MNH_ALLOCATE_ZT4D(ZSVS ,SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1 )
+! acc enter data create(ZSVT,ZSVS)
+#endif
ZSVT(:,:,:,:) = PSVT(:,:,:,ISVBEG:ISVEND)
ZSVS(:,:,:,:) = PSVS(:,:,:,ISVBEG:ISVEND)
END IF
@@ -609,11 +649,12 @@ END IF
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
! ---------------------------------------
!
-!$acc kernels present(PTHS,PRS,PRHODJ,PPABST,ZEXN,ZLV,ZLS,ZCPH,ZSVS)
+!$acc kernels ! present(PTHS,PRS,PRHODJ,PPABST,ZEXN,ZLV,ZLS,ZCPH,ZSVS)
PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
-DO JRR = 1,KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
-END DO
+!
+DO CONCURRENT ( JI=1:JIU,JJ=1:JJU,JK=1:JKU ,JRR = 1:KRR )
+ PRS(JI,JJ,JK,JRR) = PRS(JI,JJ,JK,JRR) / PRHODJ(JI,JJ,JK)
+END DO ! CONCURRENT
!
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
DO JSV = 1,SIZE(ZSVS,4)
@@ -681,15 +722,17 @@ ENDIF
! microphysical routines would save
! computing time
!
+DO CONCURRENT ( JI=1:JIU,JJ=1:JJU,JK=1:JKU)
#ifndef MNH_BITREP
-ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+ZEXN(JI,JJ,JK) = (PPABST(JI,JJ,JK)/XP00) ** (XRD/XCPD)
#else
-ZEXN(:,:,:) = BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD)
+ZEXN(JI,JJ,JK) = BR_POW(PPABST(JI,JJ,JK)/XP00,XRD/XCPD)
#endif
-ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
-ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
-ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
-ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
+ZT(JI,JJ,JK)= PTHT(JI,JJ,JK)*ZEXN(JI,JJ,JK)
+ZLV(JI,JJ,JK)=XLVTT +(XCPV-XCL) *(ZT(JI,JJ,JK)-XTT)
+ZLS(JI,JJ,JK)=XLSTT +(XCPV-XCI) *(ZT(JI,JJ,JK)-XTT)
+ZCPH(JI,JJ,JK)=XCPD +XCPV*PRT(JI,JJ,JK,1)
+END DO ! CONCURRENT
!$acc end kernels
!
!
@@ -835,7 +878,7 @@ CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
END IF
#else
#if 1
-!$acc kernels present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR)
+!$acc kernels ! present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR)
!$acc loop independent collapse(3)
DO JK=1,SIZE(PZZ,3)
DO JJ=1,SIZE(PZZ,2)
@@ -874,7 +917,7 @@ CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
END DO
!$acc end kernels
#else
-!$acc kernels present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR)
+!$acc kernels ! present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR)
DO JK=1,SIZE(PZZ,3)
DO JJ=1,SIZE(PZZ,2)
DO JI=1,SIZE(PZZ,1)
@@ -1474,10 +1517,17 @@ END IF
! ---------------------------------------
!
!$acc kernels
-PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
+DO CONCURRENT ( JI=1:JIU,JJ=1:JJU,JK=1:JKU)
+ PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) * PRHODJ(JI,JJ,JK)
+END DO ! CONCURRENT
+!$acc end kernels
!
-DO JRR = 1,KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
+!$acc kernels
+!$acc loop seq
+DO JRR=1,KRR
+ DO CONCURRENT ( JI=1:JIU,JJ=1:JJU,JK=1:JKU )
+ PRS(JI,JJ,JK,JRR) = PRS(JI,JJ,JK,JRR) * PRHODJ(JI,JJ,JK)
+ END DO ! CONCURRENT
END DO
!$acc end kernels
!
@@ -1487,8 +1537,14 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA')
ENDDO
DO JSV = 1,SIZE(ZSVT,4)
PSVT(:,:,:,JSV+ISVBEG-1) = ZSVT(:,:,:,JSV)
- ENDDO
-!$acc exit data delete(ZSVT,ZSVS)
+ ENDDO
+#ifndef MNH_OPENACC
+ deallocate(ZSVT,ZSVS)
+#else
+ CALL MNH_REL_ZT4D( ISVEND - ISVBEG + 1 , IZSVS)
+ CALL MNH_REL_ZT4D( ISVEND - ISVBEG + 1 , IZSVT)
+! acc exit data delete(ZSVT,ZSVS)
+#endif
ENDIF
!
IF (MPPDB_INITIALIZED) THEN
@@ -1521,6 +1577,20 @@ END IF
!$acc end data
+#ifndef MNH_OPENACC
+deallocate (LLMICRO)
+deallocate (ZDZZ,ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR,ZZZ)
+deallocate (ZINPRI)
+deallocate (ZTHSSTEP)
+deallocate (ZRSSTEP)
+#else
+CALL MNH_REL_ZT4D(SIZE(PRS,4) , IZRSSTEP )
+CALL MNH_REL_ZT3D ( IZTHSSTEP )
+CALL MNH_REL_ZT3D ( IZINPRI )
+CALL MNH_REL_ZT3D ( IZDZZ,IZT,IZEXN,IZLV,IZLS,IZCPH,IZCOR,IZZZ)
+CALL MNH_REL_GT3D ( ILLMICRO )
+#endif
+
!$acc end data
!-------------------------------------------------------------------------------
--
GitLab