From 9955fafaf95a4e06c8fbdf21c5d8170ff1877d72 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 15 Dec 2020 09:48:01 +0100
Subject: [PATCH] Philippe 15/12/2020: menu_diachro: more intelligent ygroup
allocation (waste less memory + no more risk of access out of range)
---
src/MNH/menu_diachro.f90 | 17 ++++++++++++++---
1 file changed, 14 insertions(+), 3 deletions(-)
diff --git a/src/MNH/menu_diachro.f90 b/src/MNH/menu_diachro.f90
index 78a452dea..a0401dc16 100644
--- a/src/MNH/menu_diachro.f90
+++ b/src/MNH/menu_diachro.f90
@@ -56,7 +56,8 @@ contains
!! Original 08/01/96
!! Updated PM
!! Updated JD 24/06/99 : add GPACK to disable pack option
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 15/12/2020: more intelligent ygroup allocation (waste less memory + no more risk of out of range accesses)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -81,8 +82,10 @@ CHARACTER(LEN=*), INTENT(IN) :: HGROUP
!* 0.1 Local variables
! ---------------
-!
-CHARACTER(LEN=NMNHNAMELGTMAX),DIMENSION(1500),SAVE :: YGROUP
+integer, parameter :: NALLOCSTEP = 50
+
+character(len=NMNHNAMELGTMAX), dimension(:), allocatable, save :: ygroup
+character(len=NMNHNAMELGTMAX), dimension(:), allocatable :: ygroup_tmp
INTEGER :: ILENG, J, JJ, IALREADY
INTEGER :: IRESPDIA
INTEGER,SAVE :: IGROUP=0
@@ -191,6 +194,14 @@ ELSE
ENDIF
IF(IALREADY == 0)THEN
IGROUP=IGROUP+1
+
+ !Reallocate ygroup if too small
+ if ( Modulo( igroup, NALLOCSTEP ) == 1 ) then
+ Allocate( ygroup_tmp( NALLOCSTEP * ( igroup / NALLOCSTEP + 1 ) ) )
+ ygroup_tmp( 1 : igroup - 1 ) = ygroup( 1 : igroup - 1 )
+ call Move_alloc( from = ygroup_tmp, to = ygroup )
+ end if
+
YGROUP(IGROUP)=ADJUSTL(HGROUP)
ENDIF
ENDIF
--
GitLab