From 52c3ff644ea4f01f90077b820cd0fe4f7c99becd Mon Sep 17 00:00:00 2001
From: Wautelet Philippe <waup@aeropc45.aero.obs-mip.fr>
Date: Tue, 26 Oct 2021 09:44:10 +0200
Subject: [PATCH] Philippe 26/10/2021: OpenACC: add support for 2D arrays in
real flat pool
---
src/MNH/mode_mnh_zwork.f90 | 48 +++++++++++++++++++++++++++++++++-----
1 file changed, 42 insertions(+), 6 deletions(-)
diff --git a/src/MNH/mode_mnh_zwork.f90 b/src/MNH/mode_mnh_zwork.f90
index 6f6189054..792661a9a 100644
--- a/src/MNH/mode_mnh_zwork.f90
+++ b/src/MNH/mode_mnh_zwork.f90
@@ -91,16 +91,20 @@ MODULE MODE_MNH_ZWORK
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_GET_ZT1DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_REL_ZT1DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_ALLOCATE_ZT1DFLAT = 0
+ INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_ALLOCATE_ZT2DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_ALLOCATE_ZT3DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_GETSIZE_ZT1DFLAT = 0 !Sum of all requested sizes in MNH_REL_ZT1DFLAT
+ INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_GETSIZE_ZT2DFLAT = 0 !Sum of all requested sizes in MNH_REL_ZT2DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_RELSIZE_ZT3DFLAT = 0 !Sum of all released sizes in MNH_REL_ZT1DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_ALLOCSIZE_ZT1DFLAT = 0 !Sum of all requested sizes in MNH_ALLOCATE_ZT1DFLAT
+ INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_ALLOCSIZE_ZT2DFLAT = 0 !Sum of all requested sizes in MNH_ALLOCATE_ZT1DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_ALLOCSIZE_ZT3DFLAT = 0 !Sum of all requested sizes in MNH_ALLOCATE_ZT3DFLAT
INTERFACE MNH_ALLOCATE_FLAT
MODULE PROCEDURE :: MNH_ALLOCATE_ZT1DFLAT_INT32
MODULE PROCEDURE :: MNH_ALLOCATE_ZT1DFLAT_INT64
+ MODULE PROCEDURE :: MNH_ALLOCATE_ZT2DFLAT
MODULE PROCEDURE :: MNH_ALLOCATE_ZT3DFLAT
END INTERFACE MNH_ALLOCATE_FLAT
@@ -1108,6 +1112,36 @@ CONTAINS
END FUNCTION MNH_ALLOCATE_ZT1DFLAT_INT64
+ FUNCTION MNH_ALLOCATE_ZT2DFLAT( PTAB, KIB, KIE, KJB, KJE ) RESULT ( KINDEX )
+
+ REAL, POINTER, CONTIGUOUS , DIMENSION(:,:), INTENT(INOUT) :: PTAB
+ INTEGER, INTENT(IN) :: KIB
+ INTEGER, INTENT(IN) :: KIE
+ INTEGER, INTENT(IN) :: KJB
+ INTEGER, INTENT(IN) :: KJE
+ INTEGER :: KINDEX
+
+ INTEGER(KIND=MNHINT64) :: ISIZE
+ INTEGER(KIND=MNHINT64) :: IIB, IIE, IJB, IJE
+
+ NCALL_MNH_ALLOCATE_ZT2DFLAT = NCALL_MNH_ALLOCATE_ZT2DFLAT + 1
+
+ IIB = KIB
+ IIE = KIE
+ IJB = KJB
+ IJE = KJE
+
+ ISIZE = ( IIE - IIB + 1_MNHINT64 ) * ( IJE - IJB + 1_MNHINT64 )
+
+ NTOT_ALLOCSIZE_ZT2DFLAT = NTOT_ALLOCSIZE_ZT2DFLAT + ISIZE
+
+ kindex = MNH_Get_zt1dflat( isize )
+
+ ptab(KIB:KIE, KJB:KJE) => zt1dflat( NT1DFLAT_POOL_R(kindex) : NT1DFLAT_POOL_R(kindex)+isize-1 )
+
+ END FUNCTION MNH_ALLOCATE_ZT2DFLAT
+
+
FUNCTION MNH_ALLOCATE_ZT3DFLAT( PTAB, KIB, KIE, KJB, KJE, KKB, KKE ) RESULT ( KINDEX )
REAL, POINTER, CONTIGUOUS , DIMENSION(:,:,:), INTENT(INOUT) :: PTAB
@@ -1148,10 +1182,11 @@ CONTAINS
SUBROUTINE PRINT_FLATPOOL_STATS()
cmnhmsg(1) = 'Number of calls for real flat pool:'
- Write( cmnhmsg(2), "( ' MNH_GET_ZT1DFLAT = ', I20 )" ) NCALL_MNH_GET_ZT1DFLAT
- Write( cmnhmsg(3), "( ' MNH_REL_ZT1DFLAT = ', I20 )" ) NCALL_MNH_REL_ZT1DFLAT
- Write( cmnhmsg(4), "( ' MNH_ALLOCATE_ZT1DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_ZT1DFLAT
- Write( cmnhmsg(5), "( ' MNH_ALLOCATE_ZT3DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_ZT3DFLAT
+ Write( cmnhmsg(2), "( ' MNH_GET_ZT1DFLAT = ', I20 )" ) NCALL_MNH_GET_ZT1DFLAT
+ Write( cmnhmsg(3), "( ' MNH_ALLOCATE_ZT1DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_ZT1DFLAT
+ Write( cmnhmsg(4), "( ' MNH_ALLOCATE_ZT2DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_ZT2DFLAT
+ Write( cmnhmsg(5), "( ' MNH_ALLOCATE_ZT3DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_ZT3DFLAT
+ Write( cmnhmsg(6), "( ' MNH_REL_ZT1DFLAT = ', I20 )" ) NCALL_MNH_REL_ZT1DFLAT
call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
cmnhmsg(1) = 'Maximum sizes for real flat pool:'
@@ -1164,8 +1199,9 @@ CONTAINS
cmnhmsg(1) = 'Total provided and released sizes for real flat pool (in bytes):'
Write( cmnhmsg(2), "( ' Provided = ', I20 )" ) NTOT_GETSIZE_ZT1DFLAT
Write( cmnhmsg(3), "( ' 1D = ', I20 )" ) NTOT_ALLOCSIZE_ZT1DFLAT
- Write( cmnhmsg(4), "( ' 3D = ', I20 )" ) NTOT_ALLOCSIZE_ZT3DFLAT
- Write( cmnhmsg(5), "( ' Released = ', I20 )" ) NTOT_RELSIZE_ZT3DFLAT
+ Write( cmnhmsg(4), "( ' 2D = ', I20 )" ) NTOT_ALLOCSIZE_ZT2DFLAT
+ Write( cmnhmsg(5), "( ' 3D = ', I20 )" ) NTOT_ALLOCSIZE_ZT3DFLAT
+ Write( cmnhmsg(6), "( ' Released = ', I20 )" ) NTOT_RELSIZE_ZT3DFLAT
call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
END SUBROUTINE PRINT_FLATPOOL_STATS
--
GitLab