Skip to content
Snippets Groups Projects
Commit ad93b283 authored by Wautelet Philippe's avatar Wautelet Philippe
Browse files

Philippe 20/10/2021: create ZT1DFLAT buffer that can be used for any size and shape arrays (real)

parent 2df57d35
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/mode_mnh_zwork.f90
+ 180
− 9
View file @ ad93b283
......@@ -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
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme