From 84d5f207d264c46c582c40fb4aac16796f59e4be Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 31 Jan 2022 15:13:35 +0100
Subject: [PATCH] Philippe 31/01/2022: OpenACC: add support for 4D arrays in
real flat pool
---
src/MNH/mode_mnh_zwork.f90 | 52 ++++++++++++++++++++++++++++++++++----
1 file changed, 47 insertions(+), 5 deletions(-)
diff --git a/src/MNH/mode_mnh_zwork.f90 b/src/MNH/mode_mnh_zwork.f90
index 2458d99da..2cb5509b4 100644
--- a/src/MNH/mode_mnh_zwork.f90
+++ b/src/MNH/mode_mnh_zwork.f90
@@ -1,5 +1,5 @@
#ifdef MNH_OPENACC
-!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2022 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -103,7 +103,7 @@ MODULE MODE_MNH_ZWORK
!------ Real 1DFLAT pool
- INTEGER, PARAMETER :: JPMAX_T1DFLAT_R = 20 !Used to determine max size of buffer ZT1DFLAT
+ INTEGER, PARAMETER :: JPMAX_T1DFLAT_R = 60 !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(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: NT1DFLAT_POOL_R !Position in ZT1DFLAT of the beginning of each array
@@ -118,12 +118,13 @@ MODULE MODE_MNH_ZWORK
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 :: NCALL_MNH_ALLOCATE_ZT4DFLAT = 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_ZT1DFLAT = 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
+ INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_ALLOCSIZE_ZT4DFLAT = 0 !Sum of all requested sizes in MNH_ALLOCATE_ZT4DFLAT
INTERFACE MNH_ALLOCATE_FLAT
@@ -135,6 +136,7 @@ MODULE MODE_MNH_ZWORK
MODULE PROCEDURE :: MNH_ALLOCATE_ZT1DFLAT_INT64
MODULE PROCEDURE :: MNH_ALLOCATE_ZT2DFLAT
MODULE PROCEDURE :: MNH_ALLOCATE_ZT3DFLAT
+ MODULE PROCEDURE :: MNH_ALLOCATE_ZT4DFLAT
END INTERFACE MNH_ALLOCATE_FLAT
INTERFACE MNH_RELEASE_FLAT
@@ -1398,6 +1400,44 @@ CONTAINS
END FUNCTION MNH_ALLOCATE_ZT3DFLAT
+ FUNCTION MNH_ALLOCATE_ZT4DFLAT( PTAB, KIB, KIE, KJB, KJE, KKB, KKE, KPB, KPE ) 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, INTENT(IN) :: KKB
+ INTEGER, INTENT(IN) :: KKE
+ INTEGER, INTENT(IN) :: KPB
+ INTEGER, INTENT(IN) :: KPE
+ INTEGER :: KINDEX
+
+ INTEGER(KIND=MNHINT64) :: ISIZE
+ INTEGER(KIND=MNHINT64) :: IIB, IIE, IJB, IJE, IKB, IKE, IPB, IPE
+
+ NCALL_MNH_ALLOCATE_ZT4DFLAT = NCALL_MNH_ALLOCATE_ZT4DFLAT + 1
+
+ IIB = KIB
+ IIE = KIE
+ IJB = KJB
+ IJE = KJE
+ IKB = KKB
+ IKE = KKE
+ IPB = KPB
+ IPE = KPE
+
+ ISIZE = ( IIE - IIB + 1_MNHINT64 ) * ( IJE - IJB + 1_MNHINT64 ) * ( IKE - IKB + 1_MNHINT64 ) * ( IPE - IPB + 1_MNHINT64 )
+
+ NTOT_ALLOCSIZE_ZT4DFLAT = NTOT_ALLOCSIZE_ZT4DFLAT + ISIZE
+
+ kindex = MNH_Get_zt1dflat( isize )
+
+ ptab(KIB:KIE, KJB:KJE, KKB:KKE, KPB:KPE ) => zt1dflat( NT1DFLAT_POOL_R(kindex) : NT1DFLAT_POOL_R(kindex)+isize-1 )
+
+ END FUNCTION MNH_ALLOCATE_ZT4DFLAT
+
+
! End Real 1DFLAT management
@@ -1432,7 +1472,8 @@ CONTAINS
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
+ Write( cmnhmsg(6), "( ' MNH_ALLOCATE_ZT4DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_ZT4DFLAT
+ Write( cmnhmsg(7), "( ' MNH_REL_ZT1DFLAT = ', I20 )" ) NCALL_MNH_REL_ZT1DFLAT
call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
cmnhmsg(1) = 'REAL flat pool: Maximum sizes:'
@@ -1447,7 +1488,8 @@ CONTAINS
Write( cmnhmsg(3), "( ' 1D = ', I20 )" ) NTOT_ALLOCSIZE_ZT1DFLAT
Write( cmnhmsg(4), "( ' 2D = ', I20 )" ) NTOT_ALLOCSIZE_ZT2DFLAT
Write( cmnhmsg(5), "( ' 3D = ', I20 )" ) NTOT_ALLOCSIZE_ZT3DFLAT
- Write( cmnhmsg(6), "( ' Released = ', I20 )" ) NTOT_RELSIZE_ZT1DFLAT
+ Write( cmnhmsg(6), "( ' 4D = ', I20 )" ) NTOT_ALLOCSIZE_ZT4DFLAT
+ Write( cmnhmsg(7), "( ' Released = ', I20 )" ) NTOT_RELSIZE_ZT1DFLAT
call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
END SUBROUTINE PRINT_FLATPOOL_STATS
--
GitLab