From 2152f15b445d33fde69dd92fa8bae540eb62eee0 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 28 Mar 2022 14:58:24 +0200
Subject: [PATCH] Philippe 28/03/2022: memory pool management: add optional
name + stat on pool size
---
src/MNH/mode_mnh_zwork.f90 | 60 ++++++++++++++++++++++++++++++++++----
1 file changed, 54 insertions(+), 6 deletions(-)
diff --git a/src/MNH/mode_mnh_zwork.f90 b/src/MNH/mode_mnh_zwork.f90
index d2d7f15ae..fa40a810b 100644
--- a/src/MNH/mode_mnh_zwork.f90
+++ b/src/MNH/mode_mnh_zwork.f90
@@ -79,6 +79,9 @@ MODULE MODE_MNH_ZWORK
INTEGER,SAVE , ALLOCATABLE, TARGET , DIMENSION(:) :: IT1D_OSIZE
+ INTEGER, PARAMETER :: NPOSNAMESZ = 32
+ CHARACTER(LEN=NPOSNAMESZ), PARAMETER :: CPOSNAME_DEFAULT = 'NOTSET'
+
TYPE :: TMNH_MEM_POS
INTEGER :: NPOS_G = NNEGUNDEF !Position in the logical array
INTEGER :: NPOS_I = NNEGUNDEF !Position in the integer array
@@ -87,6 +90,8 @@ MODULE MODE_MNH_ZWORK
INTEGER :: NPOS_POOL_G = NNEGUNDEF !Position in the logical pool array
INTEGER :: NPOS_POOL_I = NNEGUNDEF !Position in the integer pool array
INTEGER :: NPOS_POOL_R = NNEGUNDEF !Position in the real pool array
+
+ CHARACTER(LEN=NPOSNAMESZ) :: CNAME = CPOSNAME_DEFAULT
END TYPE TMNH_MEM_POS
INTEGER, PARAMETER :: JPPOOLSTEP_FLAT = 10 !Number of elements added to the pool when too small
@@ -144,9 +149,9 @@ MODULE MODE_MNH_ZWORK
!------ Real 1DFLAT pool
- INTEGER, PARAMETER :: JPMAX_T1DFLAT_R = 80 !Used to determine max size of buffer ZT1DFLAT
+ INTEGER, PARAMETER :: JPMAX_T1DFLAT_R = 120 !Used to determine max size of buffer ZT1DFLAT
!(3D size of the mesh * JPMAX_T1DFLAT_R)
- INTEGER, SAVE :: NPMAX_POOL_T1DFLAT_R = 100 !Maximum size of the pool (max number of arrays)
+ INTEGER, SAVE :: NPMAX_POOL_T1DFLAT_R = 250 !Maximum size of the pool (max number of arrays)
INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: NT1DFLAT_POOL_R !Position in ZT1DFLAT of the beginning of each array
INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: NT1DFLAT_SIZE_R !Size of each array
INTEGER(KIND=MNHINT64), SAVE :: NT1DFLAT_MAXSIZE_R !Total allocated size of ZT1DFLAT
@@ -1803,20 +1808,28 @@ CONTAINS
- SUBROUTINE MNH_MEM_POSITION_PIN()
+ SUBROUTINE MNH_MEM_POSITION_PIN( HSUBR )
! Function that stores the current position of the different preallocated arrays in the position pool
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HSUBR !Name of the calling subroutine
+
CHARACTER(LEN=32) :: YMAX, YSIZE
TYPE(TMNH_MEM_POS), ALLOCATABLE, DIMENSION(:) :: TZPOOL
NCALL_MNH_MEM_POSITION_PIN = NCALL_MNH_MEM_POSITION_PIN + 1
NPOOL_POS = NPOOL_POS + 1
+ IF ( NPOOL_POS > NPOOL_POS_MAX ) NPOOL_POS_MAX = NPOOL_POS
IF ( NPOOL_POS > NMAXSIZE_POOL_POS ) THEN
WRITE( YSIZE, '( I0 )' ) NMAXSIZE_POOL_POS
WRITE( YMAX, '( I0 )' ) NMAXSIZE_POOL_POS + JPPOOLSTEP_FLAT
- call Print_msg( NVERB_INFO, 'GEN', 'MNH_MEM_POSITION_PIN', 'pool was too small (' // TRIM( YSIZE ) &
- // '->' // TRIM( YMAX ) // ')' )
+ IF ( PRESENT( HSUBR) ) THEN
+ call Print_msg( NVERB_INFO, 'GEN', 'MNH_MEM_POSITION_PIN', TRIM( HSUBR ) // 'pool was too small (' // TRIM( YSIZE ) &
+ // '->' // TRIM( YMAX ) // ')' )
+ ELSE
+ call Print_msg( NVERB_INFO, 'GEN', 'MNH_MEM_POSITION_PIN', 'pool was too small (' // TRIM( YSIZE ) &
+ // '->' // TRIM( YMAX ) // ')' )
+ END IF
ALLOCATE( TZPOOL(NMAXSIZE_POOL_POS + JPPOOLSTEP_FLAT) )
@@ -1827,6 +1840,12 @@ CONTAINS
NMAXSIZE_POOL_POS = NMAXSIZE_POOL_POS + JPPOOLSTEP_FLAT
END IF
+ IF ( PRESENT( HSUBR ) ) THEN
+ TPOOL_POS(NPOOL_POS)%CNAME = TRIM( HSUBR )
+ ELSE
+ TPOOL_POS(NPOOL_POS)%CNAME = TRIM( CPOSNAME_DEFAULT )
+ END IF
+
TPOOL_POS(NPOOL_POS)%NPOS_G = NT1DFLAT_POS_G !Position in the logical array
TPOOL_POS(NPOOL_POS)%NPOS_I = NT1DFLAT_POS_I !Position in the integer array
TPOOL_POS(NPOOL_POS)%NPOS_R = NT1DFLAT_POS_R !Position in the real array
@@ -1838,14 +1857,38 @@ CONTAINS
END SUBROUTINE MNH_MEM_POSITION_PIN
- SUBROUTINE MNH_MEM_RELEASE( )
+ SUBROUTINE MNH_MEM_RELEASE( HSUBR )
! Function that set the current position in the different preallocated arrays
! to the last values in the position pool
! This can be used to release previously allocated memory
USE MODD_PARAMETERS, ONLY: NNEGUNDEF
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HSUBR !Name of the calling subroutine
+
+ CHARACTER(LEN=NPOSNAMESZ) :: YNAME
+
NCALL_MNH_MEM_RELEASE = NCALL_MNH_MEM_RELEASE + 1
+ IF ( NPOOL_POS < 1 ) THEN
+ IF ( PRESENT( HSUBR ) ) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH_MEM_RELEASE', &
+ TRIM( HSUBR ) // ': trying to release pool memory but nothing pinned' )
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH_MEM_RELEASE', 'trying to release pool memory but nothing pinned' )
+ END IF
+ END IF
+
+ IF ( PRESENT( HSUBR ) ) THEN
+ YNAME = TRIM( HSUBR )
+ ELSE
+ YNAME = TRIM( CPOSNAME_DEFAULT )
+ END IF
+
+ IF ( YNAME /= TPOOL_POS(NPOOL_POS)%CNAME ) THEN
+ call Print_msg( NVERB_ERROR, 'GEN', 'MNH_MEM_RELEASE', 'asked to release ' // TRIM( YNAME) &
+ // ' but expected ' // TRIM( TPOOL_POS(NPOOL_POS)%CNAME ) )
+ END IF
+
!Stats for sizes
NTOT_RELSIZE_GT1DFLAT = NTOT_RELSIZE_GT1DFLAT + NT1DFLAT_POS_G - TPOOL_POS(NPOOL_POS)%NPOS_G
NTOT_RELSIZE_IT1DFLAT = NTOT_RELSIZE_IT1DFLAT + NT1DFLAT_POS_I - TPOOL_POS(NPOOL_POS)%NPOS_I
@@ -1886,6 +1929,11 @@ CONTAINS
SUBROUTINE PRINT_FLATPOOL_STATS()
+ cmnhmsg(1) = 'MNH memory pool size):'
+ Write( cmnhmsg(2), "( ' Entries (current / max used / max avail) = ', I10, '/', I10, '/', I10, &
+ ' (max is automatically increased if necessary)' )" ) NPOOL_POS, NPOOL_POS_MAX, NMAXSIZE_POOL_POS
+ call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
+
cmnhmsg(1) = 'MNH memory pool: number of calls:'
Write( cmnhmsg(2), "( ' MNH_MEM_POSITION_PIN = ', I20 )" ) NCALL_MNH_MEM_POSITION_PIN
Write( cmnhmsg(3), "( ' MNH_MEM_RELEASE = ', I20 )" ) NCALL_MNH_MEM_RELEASE
--
GitLab