Skip to content
Snippets Groups Projects
Commit 9d1d6ed3 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 31/01/2022: OpenACC: create IT1DFLAT buffer that can be used for any... 

Philippe 31/01/2022: OpenACC: create IT1DFLAT buffer that can be used for any size and shape arrays (integer)
parent 84d5f207
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
+ 242
− 0
View file @ 9d1d6ed3
......@@ -102,6 +102,30 @@ MODULE MODE_MNH_ZWORK
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_ALLOCSIZE_GT3DFLAT = 0 !Sum of all requested sizes in MNH_ALLOCATE_ZT3DFLAT
!------ Integer 1DFLAT pool
INTEGER, PARAMETER :: JPMAX_T1DFLAT_I = 10 !Used to determine max size of buffer IT1DFLAT
!(3D size of the mesh * JPMAX_T1DFLAT_I)
INTEGER, SAVE :: NPMAX_POOL_T1DFLAT_I = 100 !Maximum size of the pool (max number of arrays)
INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: NT1DFLAT_POOL_I !Position in ZT1DFLAT of the beginning of each array
INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: NT1DFLAT_SIZE_I !Size of each array
INTEGER(KIND=MNHINT64), SAVE :: NT1DFLAT_MAXSIZE_I !Total allocated size of ZT1DFLAT
INTEGER, SAVE :: NT1DFLAT_TOP_I, NT1DFLAT_TOP_I_MAX = 0 !Position in the pool
INTEGER(KIND=MNHINT64), SAVE :: NT1DFLAT_POS_I, NT1DFLAT_POS_I_MAX = 0 !Position in the array
INTEGER, SAVE, ALLOCATABLE, TARGET, DIMENSION(:) :: IT1DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_GET_IT1DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_REL_IT1DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_ALLOCATE_IT1DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_ALLOCATE_IT2DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NCALL_MNH_ALLOCATE_IT3DFLAT = 0
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_GETSIZE_IT1DFLAT = 0 !Sum of all requested sizes in MNH_REL_IT1DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_GETSIZE_IT2DFLAT = 0 !Sum of all requested sizes in MNH_REL_IT2DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_RELSIZE_IT1DFLAT = 0 !Sum of all released sizes in MNH_REL_IT1DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_ALLOCSIZE_IT1DFLAT = 0 !Sum of all requested sizes in MNH_ALLOCATE_IT1DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_ALLOCSIZE_IT2DFLAT = 0 !Sum of all requested sizes in MNH_ALLOCATE_IT2DFLAT
INTEGER(KIND=MNHINT64), PRIVATE, SAVE :: NTOT_ALLOCSIZE_IT3DFLAT = 0 !Sum of all requested sizes in MNH_ALLOCATE_IT3DFLAT
!------ Real 1DFLAT pool
INTEGER, PARAMETER :: JPMAX_T1DFLAT_R = 60 !Used to determine max size of buffer ZT1DFLAT
!(3D size of the mesh * JPMAX_T1DFLAT_R)
......@@ -132,6 +156,10 @@ MODULE MODE_MNH_ZWORK
MODULE PROCEDURE :: MNH_ALLOCATE_GT1DFLAT_INT64
MODULE PROCEDURE :: MNH_ALLOCATE_GT2DFLAT
MODULE PROCEDURE :: MNH_ALLOCATE_GT3DFLAT
MODULE PROCEDURE :: MNH_ALLOCATE_IT1DFLAT_INT32
MODULE PROCEDURE :: MNH_ALLOCATE_IT1DFLAT_INT64
MODULE PROCEDURE :: MNH_ALLOCATE_IT2DFLAT
MODULE PROCEDURE :: MNH_ALLOCATE_IT3DFLAT
MODULE PROCEDURE :: MNH_ALLOCATE_ZT1DFLAT_INT32
MODULE PROCEDURE :: MNH_ALLOCATE_ZT1DFLAT_INT64
MODULE PROCEDURE :: MNH_ALLOCATE_ZT2DFLAT
......@@ -275,6 +303,18 @@ CONTAINS
NT1DFLAT_SIZE_G(:) = NNEGUNDEF
NT1DFLAT_TOP_G = 0
!------ Integer 1DFLAT pool
NT1DFLAT_MAXSIZE_I = INT( IIU, KIND=MNHINT64 ) * IJU * IKU * JPMAX_T1DFLAT_I
ALLOCATE( IT1DFLAT(NT1DFLAT_MAXSIZE_I) )
!$acc enter data create( IT1DFLAT )
ALLOCATE( NT1DFLAT_POOL_I(NPMAX_POOL_T1DFLAT_I) )
ALLOCATE( NT1DFLAT_SIZE_I(NPMAX_POOL_T1DFLAT_I) )
NT1DFLAT_POOL_I(:) = NNEGUNDEF
NT1DFLAT_SIZE_I(:) = NNEGUNDEF
NT1DFLAT_TOP_I = 0
!------ Real 1DFLAT pool
NT1DFLAT_MAXSIZE_R = INT( IIU, KIND=MNHINT64 ) * IJU * IKU * JPMAX_T1DFLAT_R
......@@ -1225,6 +1265,184 @@ CONTAINS
! End Logical 1DFLAT management
!-------- Integer 1DFLAT Pool Managment
FUNCTION MNH_GET_IT1DFLAT( 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_I
INTEGER(KIND=MNHINT64), ALLOCATABLE, DIMENSION (:) :: IT1DFLAT_SIZE_I
NCALL_MNH_GET_IT1DFLAT = NCALL_MNH_GET_IT1DFLAT + 1
NTOT_GETSIZE_IT1DFLAT = NTOT_GETSIZE_IT1DFLAT + KSIZE
IF ( NT1DFLAT_POS_I + KSIZE > NT1DFLAT_MAXSIZE_I ) THEN
WRITE( YSIZE, '( I0 )' ) KSIZE
WRITE( YAVAIL, '( I0 )' ) NT1DFLAT_MAXSIZE_I - NT1DFLAT_POS_I
WRITE( YMAX, '( I0 )' ) NT1DFLAT_MAXSIZE_I
call Print_msg( NVERB_FATAL, 'GEN', 'MNH_GET_IT1DFLAT', 'IT1DFLAT too small (asked=' // Trim( ysize ) // &
', available=' // Trim( yavail ) // ', total=' // Trim( ymax ) // ')' )
ELSE
NT1DFLAT_TOP_I = NT1DFLAT_TOP_I + 1
KINDEX = NT1DFLAT_TOP_I
IF ( KINDEX > NPMAX_POOL_T1DFLAT_I ) THEN
WRITE( YSIZE, '( I0 )' ) NPMAX_POOL_T1DFLAT_I
WRITE( YMAX, '( I0 )' ) NPMAX_POOL_T1DFLAT_I+JPPOOLSTEP_FLAT
call Print_msg( NVERB_INFO, 'GEN', 'MNH_GET_IT1DFLAT', 'pool for IT1DFLAT was too small (' // TRIM( YSIZE ) &
// '->' // TRIM( YMAX ) // ')' )
ALLOCATE( IT1DFLAT_POOL_I(NPMAX_POOL_T1DFLAT_I+JPPOOLSTEP_FLAT) )
ALLOCATE( IT1DFLAT_SIZE_I(NPMAX_POOL_T1DFLAT_I+JPPOOLSTEP_FLAT) )
IT1DFLAT_POOL_I(1:NPMAX_POOL_T1DFLAT_I) = NT1DFLAT_POOL_I(:)
IT1DFLAT_SIZE_I(1:NPMAX_POOL_T1DFLAT_I) = NT1DFLAT_SIZE_I(:)
IT1DFLAT_POOL_I(NPMAX_POOL_T1DFLAT_I+1:) = NNEGUNDEF
IT1DFLAT_SIZE_I(NPMAX_POOL_T1DFLAT_I+1:) = NNEGUNDEF
CALL MOVE_ALLOC( FROM = IT1DFLAT_POOL_I, TO = NT1DFLAT_POOL_I )
CALL MOVE_ALLOC( FROM = IT1DFLAT_SIZE_I, TO = NT1DFLAT_SIZE_I )
NPMAX_POOL_T1DFLAT_I = NPMAX_POOL_T1DFLAT_I + JPPOOLSTEP_FLAT
END IF
NT1DFLAT_POOL_I( KINDEX ) = NT1DFLAT_POS_I + 1
NT1DFLAT_SIZE_I( KINDEX ) = KSIZE
NT1DFLAT_POS_I = NT1DFLAT_POS_I + KSIZE
IF ( NT1DFLAT_TOP_I > NT1DFLAT_TOP_I_MAX ) NT1DFLAT_TOP_I_MAX = NT1DFLAT_TOP_I
IF ( NT1DFLAT_POS_I > NT1DFLAT_POS_I_MAX ) NT1DFLAT_POS_I_MAX = NT1DFLAT_POS_I
END IF
END FUNCTION MNH_GET_IT1DFLAT
SUBROUTINE MNH_REL_IT1DFLAT( KINDEX )
USE MODD_PARAMETERS, ONLY: NNEGUNDEF
IMPLICIT NONE
INTEGER :: KINDEX
NCALL_MNH_REL_IT1DFLAT = NCALL_MNH_REL_IT1DFLAT + 1
!Release only if last block
IF ( KINDEX /= NT1DFLAT_TOP_I ) &
call Print_msg( NVERB_FATAL, 'GEN', 'MNH_REL_IT1DFLAT', 'trying to release block that is not the last one' )
NTOT_RELSIZE_IT1DFLAT = NTOT_RELSIZE_IT1DFLAT + NT1DFLAT_SIZE_I( KINDEX )
NT1DFLAT_TOP_I = NT1DFLAT_TOP_I - 1
NT1DFLAT_POS_I = NT1DFLAT_POS_I - NT1DFLAT_SIZE_I( KINDEX )
NT1DFLAT_POOL_I( KINDEX ) = NNEGUNDEF
NT1DFLAT_SIZE_I( KINDEX ) = NNEGUNDEF
END SUBROUTINE MNH_REL_IT1DFLAT
FUNCTION MNH_ALLOCATE_IT1DFLAT_INT32( KTAB, KSIZE ) RESULT( KINDEX )
INTEGER, POINTER, CONTIGUOUS , DIMENSION(:), INTENT(INOUT) :: KTAB
INTEGER(KIND=MNHINT32), INTENT(IN) :: KSIZE
INTEGER :: KINDEX
kindex = MNH_Allocate_it1dflat_int64( ktab, Int( ksize, kind = MNHINT64 ) )
END FUNCTION MNH_ALLOCATE_IT1DFLAT_INT32
FUNCTION MNH_ALLOCATE_IT1DFLAT_INT64( KTAB, KSIZE ) RESULT( KINDEX )
INTEGER, POINTER, CONTIGUOUS , DIMENSION(:), INTENT(INOUT) :: KTAB
INTEGER(KIND=MNHINT64), INTENT(IN) :: KSIZE
INTEGER :: KINDEX
NCALL_MNH_ALLOCATE_IT1DFLAT = NCALL_MNH_ALLOCATE_IT1DFLAT + 1
NTOT_ALLOCSIZE_IT1DFLAT = NTOT_ALLOCSIZE_IT1DFLAT + KSIZE
kindex = MNH_Get_it1dflat( ksize )
ktab(1:KSIZE) => it1dflat( NT1DFLAT_POOL_I(kindex) : NT1DFLAT_POOL_I(kindex)+ksize-1 )
END FUNCTION MNH_ALLOCATE_IT1DFLAT_INT64
FUNCTION MNH_ALLOCATE_IT2DFLAT( KTAB, KIB, KIE, KJB, KJE ) RESULT ( KINDEX )
INTEGER, POINTER, CONTIGUOUS , DIMENSION(:,:), INTENT(INOUT) :: KTAB
INTEGER, INTENT(IN) :: KIB
INTEGER, INTENT(IN) :: KIE
INTEGER, INTENT(IN) :: KJB
INTEGER, INTENT(IN) :: KJE
INTEGER :: KINDEX
INTEGER(KIND=MNHINT64) :: ISIZE
INTEGER(KIND=MNHINT64) :: IIB, IIE, IJB, IJE
NCALL_MNH_ALLOCATE_IT2DFLAT = NCALL_MNH_ALLOCATE_IT2DFLAT + 1
IIB = KIB
IIE = KIE
IJB = KJB
IJE = KJE
ISIZE = ( IIE - IIB + 1_MNHINT64 ) * ( IJE - IJB + 1_MNHINT64 )
NTOT_ALLOCSIZE_IT2DFLAT = NTOT_ALLOCSIZE_IT2DFLAT + ISIZE
kindex = MNH_Get_it1dflat( isize )
ktab(KIB:KIE, KJB:KJE) => it1dflat( NT1DFLAT_POOL_I(kindex) : NT1DFLAT_POOL_I(kindex)+isize-1 )
END FUNCTION MNH_ALLOCATE_IT2DFLAT
FUNCTION MNH_ALLOCATE_IT3DFLAT( KTAB, KIB, KIE, KJB, KJE, KKB, KKE ) RESULT ( KINDEX )
INTEGER, POINTER, CONTIGUOUS , DIMENSION(:,:,:), INTENT(INOUT) :: KTAB
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
NCALL_MNH_ALLOCATE_IT3DFLAT = NCALL_MNH_ALLOCATE_IT3DFLAT + 1
IIB = KIB
IIE = KIE
IJB = KJB
IJE = KJE
IKB = KKB
IKE = KKE
ISIZE = ( IIE - IIB + 1_MNHINT64 ) * ( IJE - IJB + 1_MNHINT64 ) * ( IKE - IKB + 1_MNHINT64 )
NTOT_ALLOCSIZE_IT3DFLAT = NTOT_ALLOCSIZE_IT3DFLAT + ISIZE
kindex = MNH_Get_it1dflat( isize )
ktab(KIB:KIE, KJB:KJE, KKB:KKE) => it1dflat( NT1DFLAT_POOL_I(kindex) : NT1DFLAT_POOL_I(kindex)+isize-1 )
END FUNCTION MNH_ALLOCATE_IT3DFLAT
! End Integer 1DFLAT management
!-------- Real 1DFLAT Pool Managment
FUNCTION MNH_GET_ZT1DFLAT( KSIZE ) RESULT( KINDEX )
......@@ -1467,6 +1685,30 @@ CONTAINS
call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
cmnhmsg(1) = 'INTEGER flat pool: Number of calls:'
Write( cmnhmsg(2), "( ' MNH_GET_IT1DFLAT = ', I20 )" ) NCALL_MNH_GET_IT1DFLAT
Write( cmnhmsg(3), "( ' MNH_ALLOCATE_IT1DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_IT1DFLAT
Write( cmnhmsg(4), "( ' MNH_ALLOCATE_IT2DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_IT2DFLAT
Write( cmnhmsg(5), "( ' MNH_ALLOCATE_IT3DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_IT3DFLAT
Write( cmnhmsg(6), "( ' MNH_REL_IT1DFLAT = ', I20 )" ) NCALL_MNH_REL_IT1DFLAT
call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
cmnhmsg(1) = 'INTEGER flat pool: Maximum sizes:'
Write( cmnhmsg(2), "( ' Entries (current / max used / max avail) = ', I10, '/', I10, '/', I10, &
' (max is automatically increased if necessary)' )" ) NT1DFLAT_TOP_I, NT1DFLAT_TOP_I_MAX, NPMAX_POOL_T1DFLAT_I
Write( cmnhmsg(3), "( ' Memory (current / max used / max avail) = ', I20, '/', I20, '/', I20 )" ) &
NT1DFLAT_POS_I, NT1DFLAT_POS_I_MAX, NT1DFLAT_MAXSIZE_I
call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
cmnhmsg(1) = 'INTEGER flat pool: Total provided and released sizes (in bytes):'
Write( cmnhmsg(2), "( ' Provided = ', I20 )" ) NTOT_GETSIZE_IT1DFLAT
Write( cmnhmsg(3), "( ' 1D = ', I20 )" ) NTOT_ALLOCSIZE_IT1DFLAT
Write( cmnhmsg(4), "( ' 2D = ', I20 )" ) NTOT_ALLOCSIZE_IT2DFLAT
Write( cmnhmsg(5), "( ' 3D = ', I20 )" ) NTOT_ALLOCSIZE_IT3DFLAT
Write( cmnhmsg(6), "( ' Released = ', I20 )" ) NTOT_RELSIZE_IT1DFLAT
call Print_msg( NVERB_INFO, 'GEN', 'FLAT_STATS' )
cmnhmsg(1) = 'REAL flat pool: Number of calls:'
Write( cmnhmsg(2), "( ' MNH_GET_ZT1DFLAT = ', I20 )" ) NCALL_MNH_GET_ZT1DFLAT
Write( cmnhmsg(3), "( ' MNH_ALLOCATE_ZT1DFLAT = ', I20 )" ) NCALL_MNH_ALLOCATE_ZT1DFLAT
......
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