diff --git a/src/MNH/mode_mnh_zwork.f90 b/src/MNH/mode_mnh_zwork.f90
index d1a0d05703d839120082ed2dcea7ef0772a86bc7..6c9d5d374190b58269352d0349a520c3335a0474 100644
--- a/src/MNH/mode_mnh_zwork.f90
+++ b/src/MNH/mode_mnh_zwork.f90
@@ -6,9 +6,12 @@
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 10/07/2019: bugfix: MNH_REL_ZT3D_N0: access outside of array was possible
+! P. Wautelet 20/10/2021: create ZT1DFLAT buffer that can be used for any size and shape arrays (real)
!-----------------------------------------------------------------
MODULE MODE_MNH_ZWORK
+ use modd_precision, only: MNHINT32, MNHINT64
+
use mode_msg
IMPLICIT NONE
@@ -71,15 +74,37 @@ MODULE MODE_MNH_ZWORK
INTEGER :: NT1D_TOP_I , NT1D_TOP_I_MAX = 0
INTEGER,SAVE , ALLOCATABLE, TARGET , DIMENSION(:,:) :: IT1D
INTEGER,SAVE , ALLOCATABLE, TARGET , DIMENSION(:) :: IT1D_OSIZE
-
+
+
+ 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
+ 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
+ INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: NT1DFLAT_SIZE_R !Size of each array
+ INTEGER(KIND=MNHINT64), SAVE :: NT1DFLAT_MAXSIZE !Total allocated size of ZT1DFLAT
+ INTEGER, SAVE :: NT1DFLAT_TOP_R, NT1DFLAT_TOP_R_MAX = 0 !Position in the pool
+ INTEGER(KIND=MNHINT64), SAVE :: NT1DFLAT_POS_R, NT1DFLAT_POS_R_MAX = 0 !Position in the array
+ REAL, SAVE, ALLOCATABLE, TARGET, DIMENSION(:) :: ZT1DFLAT
+
+ INTERFACE MNH_ALLOCATE_FLAT
+ MODULE PROCEDURE :: MNH_ALLOCATE_ZT1DFLAT_INT32
+ MODULE PROCEDURE :: MNH_ALLOCATE_ZT1DFLAT_INT64
+ MODULE PROCEDURE :: MNH_ALLOCATE_ZT3DFLAT
+ END INTERFACE MNH_ALLOCATE_FLAT
+
+ INTERFACE MNH_RELEASE_FLAT
+ MODULE PROCEDURE :: MNH_REL_ZT1DFLAT
+ END INTERFACE MNH_RELEASE_FLAT
+
CONTAINS
SUBROUTINE MNH_ALLOC_ZWORK(IMODEL)
- USE MODE_TOOLS_ll, ONLY : GET_DIM_EXT_ll, GET_INDICE_ll, LWEST_ll,LEAST_ll, LSOUTH_ll, LNORTH_ll
+ USE MODE_TOOLS_ll, ONLY: GET_DIM_EXT_ll, GET_INDICE_ll, LWEST_ll, LEAST_ll, LSOUTH_ll, LNORTH_ll
- USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
- USE MODD_DIM_n, ONLY : NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT, NNEGUNDEF, XUNDEF
+ USE MODD_DIM_n, ONLY: NKMAX
IMPLICIT NONE
@@ -192,6 +217,18 @@ CONTAINS
NT1D_POOL_I(JI) = JI
END DO
+!------ Real 1DFLAT pool
+
+ NT1DFLAT_MAXSIZE = INT( IIU, KIND=MNHINT64 ) * IJU * IKU * JPMAX_T1DFLAT_R
+ ALLOCATE( ZT1DFLAT(NT1DFLAT_MAXSIZE) )
+ !$acc enter data create( ZT1DFLAT )
+
+ ALLOCATE( NT1DFLAT_POOL_R(NPMAX_POOL_T1DFLAT_R) )
+ ALLOCATE( NT1DFLAT_SIZE_R(NPMAX_POOL_T1DFLAT_R) )
+ NT1DFLAT_POOL_R(:) = NNEGUNDEF
+ NT1DFLAT_SIZE_R(:) = NNEGUNDEF
+ NT1DFLAT_TOP_R = 0
+
!------ Default values
!$acc kernels
@@ -201,8 +238,9 @@ CONTAINS
ZUNIT3D = 1.0
- ZT3D = XUNDEF
- ZT1D = XUNDEF
+ ZT3D(:,:,:,:) = XUNDEF
+ ZT1D(:,:) = XUNDEF
+ ZT1DFLAT(:) = XUNDEF
IT3D = 0.0
IT1D = 0.0
@@ -213,7 +251,7 @@ CONTAINS
!$acc update host (ZPSRC_HALO2_WEST,ZPSRC_HALO2_SOUTH)
!$acc update host (ZUNIT3D)
- !$acc update host (ZT3D,ZT1D)
+ !$acc update host (ZT3D,ZT1D,ZT1DFLAT)
END IF
@@ -482,7 +520,7 @@ CONTAINS
!local
- IF ( (KI .EQ. IIU) .AND. (KJ .EQ. IJU) .AND. (KKB .LE. IKU) .AND. (KKE .LE. IKU) ) THEN
+ IF ( (KI .EQ. IIU) .AND. (KJ .EQ. IJU) .AND. (KKB .LE. IKU) .AND. (KKE .LE. IKU) ) THEN
CALL MNH_GET_ZT3D_N0(KINDEX)
PTAB(1:,1:,KKB:) => ZT3D(:,:,KKB:KKE,KINDEX)
ELSE
@@ -935,7 +973,7 @@ CONTAINS
IF (KI .LE. IIJKU) THEN
CALL MNH_GET_IT1D_N0(KINDEX)
IF (KI .NE. 0) THEN
- PTAB(1:KI) => IT1D(:,KINDEX)
+ PTAB(1:KI) => IT1D(1:KI,KINDEX)
ELSE
PTAB => IT1D_OSIZE
END IF
@@ -948,6 +986,139 @@ CONTAINS
! End Integer 1D management
+ !-------- Real 1DFLAT Pool Managment
+
+ FUNCTION MNH_GET_ZT1DFLAT( KSIZE ) RESULT( KINDEX )
+
+ USE MODD_PARAMETERS, ONLY: NNEGUNDEF
+
+ IMPLICIT NONE
+
+ INTEGER(KIND=MNHINT64), INTENT(IN) :: KSIZE
+ INTEGER :: KINDEX
+
+ CHARACTER(LEN=32) :: YAVAIL, YMAX, YSIZE
+ INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: IT1DFLAT_POOL_R
+ INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: IT1DFLAT_SIZE_R
+
+ IF ( NT1DFLAT_POS_R + KSIZE > NT1DFLAT_MAXSIZE ) THEN
+ WRITE( YSIZE, '( I0 )' ) KSIZE
+ WRITE( YAVAIL, '( I0 )' ) NT1DFLAT_MAXSIZE - NT1DFLAT_POS_R
+ WRITE( YMAX, '( I0 )' ) NT1DFLAT_MAXSIZE
+ call Print_msg( NVERB_FATAL, 'GEN', 'MNH_GET_ZT1DFLAT', 'ZT1DFLAT too small (asked=' // Trim( ysize ) // &
+ ', available=' // Trim( yavail ) // ', total=' // Trim( ymax ) // ')' )
+ ELSE
+ NT1DFLAT_TOP_R = NT1DFLAT_TOP_R + 1
+ KINDEX = NT1DFLAT_TOP_R
+
+ IF ( KINDEX > NPMAX_POOL_T1DFLAT_R ) THEN
+ WRITE( YSIZE, '( I0 )' ) NPMAX_POOL_T1DFLAT_R
+ WRITE( YMAX, '( I0 )' ) NPMAX_POOL_T1DFLAT_R+JPPOOLSTEP_FLAT
+ call Print_msg( NVERB_INFO, 'GEN', 'MNH_GET_ZT1DFLAT', 'pool for ZT1DFLAT was too small (' // TRIM( YSIZE ) &
+ // '->' // TRIM( YMAX ) // ')' )
+
+ ALLOCATE( IT1DFLAT_POOL_R(NPMAX_POOL_T1DFLAT_R+JPPOOLSTEP_FLAT) )
+ ALLOCATE( IT1DFLAT_SIZE_R(NPMAX_POOL_T1DFLAT_R+JPPOOLSTEP_FLAT) )
+
+ IT1DFLAT_POOL_R(1:NPMAX_POOL_T1DFLAT_R) = NT1DFLAT_POOL_R(:)
+ IT1DFLAT_SIZE_R(1:NPMAX_POOL_T1DFLAT_R) = NT1DFLAT_SIZE_R(:)
+ IT1DFLAT_POOL_R(NPMAX_POOL_T1DFLAT_R+1:) = NNEGUNDEF
+ IT1DFLAT_SIZE_R(NPMAX_POOL_T1DFLAT_R+1:) = NNEGUNDEF
+
+ CALL MOVE_ALLOC( FROM = IT1DFLAT_POOL_R, TO = NT1DFLAT_POOL_R )
+ CALL MOVE_ALLOC( FROM = IT1DFLAT_SIZE_R, TO = NT1DFLAT_SIZE_R )
+
+ NPMAX_POOL_T1DFLAT_R = NPMAX_POOL_T1DFLAT_R + JPPOOLSTEP_FLAT
+ END IF
+
+ NT1DFLAT_POOL_R( KINDEX ) = NT1DFLAT_POS_R + 1
+ NT1DFLAT_SIZE_R( KINDEX ) = KSIZE
+
+ NT1DFLAT_POS_R = NT1DFLAT_POS_R + KSIZE
+
+ IF ( NT1DFLAT_TOP_R > NT1DFLAT_TOP_R_MAX ) NT1DFLAT_TOP_R_MAX = NT1DFLAT_TOP_R
+ IF ( NT1DFLAT_POS_R > NT1DFLAT_POS_R_MAX ) NT1DFLAT_POS_R_MAX = NT1DFLAT_POS_R
+ END IF
+
+ END FUNCTION MNH_GET_ZT1DFLAT
+
+
+ SUBROUTINE MNH_REL_ZT1DFLAT( KINDEX )
+
+ USE MODD_PARAMETERS, ONLY: NNEGUNDEF
+
+ IMPLICIT NONE
+
+ INTEGER :: KINDEX
+
+ !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' )
+
+ NT1DFLAT_TOP_R = NT1DFLAT_TOP_R - 1
+ NT1DFLAT_POS_R = NT1DFLAT_POS_R - NT1DFLAT_SIZE_R( KINDEX )
+
+ NT1DFLAT_POOL_R( KINDEX ) = NNEGUNDEF
+ NT1DFLAT_SIZE_R( KINDEX ) = NNEGUNDEF
+
+ END SUBROUTINE MNH_REL_ZT1DFLAT
+
+
+ FUNCTION MNH_ALLOCATE_ZT1DFLAT_INT32( PTAB, KSIZE ) RESULT( KINDEX )
+
+ REAL, POINTER, CONTIGUOUS , DIMENSION(:), INTENT(INOUT) :: PTAB
+ INTEGER(KIND=MNHINT32), INTENT(IN) :: KSIZE
+ INTEGER :: KINDEX
+
+ kindex = MNH_Allocate_zt1dflat_int64( ptab, Int( ksize, kind = MNHINT64 ) )
+
+ END FUNCTION MNH_ALLOCATE_ZT1DFLAT_INT32
+
+
+ FUNCTION MNH_ALLOCATE_ZT1DFLAT_INT64( PTAB, KSIZE ) RESULT( KINDEX )
+
+ REAL, POINTER, CONTIGUOUS , DIMENSION(:), INTENT(INOUT) :: PTAB
+ INTEGER(KIND=MNHINT64), INTENT(IN) :: KSIZE
+ INTEGER :: KINDEX
+
+ kindex = MNH_Get_zt1dflat( ksize )
+ ptab(1:KSIZE) => zt1dflat( NT1DFLAT_POOL_R(kindex) : NT1DFLAT_POOL_R(kindex)+ksize-1 )
+
+ END FUNCTION MNH_ALLOCATE_ZT1DFLAT_INT64
+
+
+ FUNCTION MNH_ALLOCATE_ZT3DFLAT( PTAB, KIB, KIE, KJB, KJE, KKB, KKE ) 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 :: KINDEX
+
+ INTEGER(KIND=MNHINT64) :: ISIZE
+ INTEGER(KIND=MNHINT64) :: IIB, IIE, IJB, IJE, IKB, IKE
+
+ IIB = KIB
+ IIE = KIE
+ IJB = KJB
+ IJE = KJE
+ IKB = KKB
+ IKE = KKE
+
+ ISIZE = ( IIE - IIB + 1_MNHINT64 ) * ( IJE - IJB + 1_MNHINT64 ) * ( IIE - IIB + 1_MNHINT64 )
+
+ 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 MNH_CHECK_IN_ZT3D(HSUB)
IMPLICIT NONE