From 83ca807f36c4a8241f4c431dc4a83aea54dd0007 Mon Sep 17 00:00:00 2001
From: Wautelet Philippe <waup@aeropc45.aero.obs-mip.fr>
Date: Tue, 26 Oct 2021 09:26:33 +0200
Subject: [PATCH] Philippe 26/10/2021: OpenACC: add stats of use of flat memory
pool
---
src/MNH/finalize_mnh.f90 | 7 +++++
src/MNH/mode_mnh_zwork.f90 | 52 ++++++++++++++++++++++++++++++++++++++
2 files changed, 59 insertions(+)
diff --git a/src/MNH/finalize_mnh.f90 b/src/MNH/finalize_mnh.f90
index faabb9972..14022cdae 100644
--- a/src/MNH/finalize_mnh.f90
+++ b/src/MNH/finalize_mnh.f90
@@ -27,6 +27,9 @@ SUBROUTINE FINALIZE_MNH
USE MODE_INIT_ll, only: END_PARA_ll
USE MODE_IO_FILE, only: IO_File_close
USE MODE_IO_MANAGE_STRUCT, only: IO_Filelist_print
+#ifdef MNH_OPENACC
+ USE MODE_MNH_ZWORK, only: PRINT_FLATPOOL_STATS
+#endif
USE MODE_MPPDB, only: MPPDB_BARRIER
USE MODE_MSG, only: MSG_STATS
@@ -42,6 +45,10 @@ SUBROUTINE FINALIZE_MNH
!Print the list of all files and some statistics on them
IF ( NIO_VERB >= NVERB_DEBUG ) CALL IO_Filelist_print()
+#ifdef MNH_OPENACC
+ CALL PRINT_FLATPOOL_STATS()
+#endif
+
!Print the number of printed messages via Print_msg
CALL MSG_STATS()
diff --git a/src/MNH/mode_mnh_zwork.f90 b/src/MNH/mode_mnh_zwork.f90
index 6c9d5d374..423c55e2c 100644
--- a/src/MNH/mode_mnh_zwork.f90
+++ b/src/MNH/mode_mnh_zwork.f90
@@ -76,6 +76,7 @@ MODULE MODE_MNH_ZWORK
INTEGER,SAVE , ALLOCATABLE, TARGET , DIMENSION(:) :: IT1D_OSIZE
+!------ Real 1DFLAT pool
INTEGER, PARAMETER :: JPMAX_T1DFLAT_R = 10 !Used to determine max size of buffer ZT1DFLAT
!(3D size of the mesh * JPMAX_T1DFLAT_R)
INTEGER, PARAMETER :: JPPOOLSTEP_FLAT = 10 !Number of elements added to the pool when too small
@@ -87,6 +88,16 @@ MODULE MODE_MNH_ZWORK
INTEGER(KIND=MNHINT64), SAVE :: NT1DFLAT_POS_R, NT1DFLAT_POS_R_MAX = 0 !Position in the array
REAL, SAVE, ALLOCATABLE, TARGET, DIMENSION(:) :: ZT1DFLAT
+ 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_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_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_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
@@ -1001,6 +1012,9 @@ CONTAINS
INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: IT1DFLAT_POOL_R
INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: IT1DFLAT_SIZE_R
+ NCALL_MNH_GET_ZT1DFLAT = NCALL_MNH_GET_ZT1DFLAT + 1
+ NTOT_GETSIZE_ZT1DFLAT = NTOT_GETSIZE_ZT1DFLAT + KSIZE
+
IF ( NT1DFLAT_POS_R + KSIZE > NT1DFLAT_MAXSIZE ) THEN
WRITE( YSIZE, '( I0 )' ) KSIZE
WRITE( YAVAIL, '( I0 )' ) NT1DFLAT_MAXSIZE - NT1DFLAT_POS_R
@@ -1051,10 +1065,14 @@ CONTAINS
INTEGER :: KINDEX
+ NCALL_MNH_REL_ZT1DFLAT = NCALL_MNH_REL_ZT1DFLAT + 1
+
!Release only if last block
IF ( KINDEX /= NT1DFLAT_TOP_R ) &
call Print_msg( NVERB_FATAL, 'GEN', 'MNH_REL_ZT1DFLAT', 'trying to release block that is not the last one' )
+ NTOT_RELSIZE_ZT3DFLAT = NTOT_RELSIZE_ZT3DFLAT + NT1DFLAT_SIZE_R( KINDEX )
+
NT1DFLAT_TOP_R = NT1DFLAT_TOP_R - 1
NT1DFLAT_POS_R = NT1DFLAT_POS_R - NT1DFLAT_SIZE_R( KINDEX )
@@ -1081,6 +1099,9 @@ CONTAINS
INTEGER(KIND=MNHINT64), INTENT(IN) :: KSIZE
INTEGER :: KINDEX
+ NCALL_MNH_ALLOCATE_ZT1DFLAT = NCALL_MNH_ALLOCATE_ZT1DFLAT + 1
+ NTOT_ALLOCSIZE_ZT1DFLAT = NTOT_ALLOCSIZE_ZT1DFLAT + KSIZE
+
kindex = MNH_Get_zt1dflat( ksize )
ptab(1:KSIZE) => zt1dflat( NT1DFLAT_POOL_R(kindex) : NT1DFLAT_POOL_R(kindex)+ksize-1 )
@@ -1101,6 +1122,8 @@ CONTAINS
INTEGER(KIND=MNHINT64) :: ISIZE
INTEGER(KIND=MNHINT64) :: IIB, IIE, IJB, IJE, IKB, IKE
+ NCALL_MNH_ALLOCATE_ZT3DFLAT = NCALL_MNH_ALLOCATE_ZT3DFLAT + 1
+
IIB = KIB
IIE = KIE
IJB = KJB
@@ -1110,15 +1133,44 @@ CONTAINS
ISIZE = ( IIE - IIB + 1_MNHINT64 ) * ( IJE - IJB + 1_MNHINT64 ) * ( IIE - IIB + 1_MNHINT64 )
+ NTOT_ALLOCSIZE_ZT3DFLAT = NTOT_ALLOCSIZE_ZT3DFLAT + ISIZE
+
kindex = MNH_Get_zt1dflat( isize )
ptab(KIB:KIE, KJB:KJE, KKB:KKE) => zt1dflat( NT1DFLAT_POOL_R(kindex) : NT1DFLAT_POOL_R(kindex)+isize-1 )
END FUNCTION MNH_ALLOCATE_ZT3DFLAT
+
! End Real 1DFLAT management
+ 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
+ call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
+
+ cmnhmsg(1) = 'Maximum sizes for real flat pool:'
+ Write( cmnhmsg(2), "( ' Entries (current / max used / max avail) = ', I10, '/', I10, '/', I10, &
+ ' (max is automatically increased if necessary)' )" ) NT1DFLAT_TOP_R, NT1DFLAT_TOP_R_MAX, NPMAX_POOL_T1DFLAT_R
+ Write( cmnhmsg(3), "( ' Memory (current / max used / max avail) = ', I20, '/', I20, '/', I20 )" ) &
+ NT1DFLAT_POS_R, NT1DFLAT_POS_R_MAX, NT1DFLAT_MAXSIZE
+ call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
+
+ 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
+ call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
+
+ END SUBROUTINE PRINT_FLATPOOL_STATS
+
+
SUBROUTINE MNH_CHECK_IN_ZT3D(HSUB)
IMPLICIT NONE
--
GitLab