Merge pull request #58 from ecmwf-ifs/naan-host-pool

Host memory pool
ecmwf-ifs · Aug 30, 2024 · 54e09f3 · 54e09f3
2 parents ca79ee8 + 0d4f791
commit 54e09f3
Show file tree

Hide file tree

Showing 10 changed files with 395 additions and 24 deletions.
diff --git a/c_malloc.c b/c_malloc.c
@@ -20,3 +20,8 @@
 {
    free(ptr);
 }
+
+ void c_ptr_incr (size_t siz, void ** ptr, void ** data)
+{
+  *data = (*ptr) + siz;
+}
diff --git a/field_RANKSUFF_factory_module.fypp b/field_RANKSUFF_factory_module.fypp
@@ -57,7 +57,8 @@ PUBLIC :: FIELD_RESIZE
 CONTAINS
 
 #:for ft in fieldTypeList
-SUBROUTINE ${ft.name}$_NEW_OWNER (FIELD_PTR, UBOUNDS, LBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR)
+SUBROUTINE ${ft.name}$_NEW_OWNER (FIELD_PTR, UBOUNDS, LBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR, &
+&                                 POOLED)
 
 USE FIELD_STATISTICS_MODULE
 
@@ -70,11 +71,12 @@ LOGICAL, OPTIONAL,  INTENT(IN) :: DELAYED
 ${ft.type}$, OPTIONAL, INTENT(IN) :: INIT_VALUE
 LOGICAL, OPTIONAL,  INTENT(IN) :: PINNED
 LOGICAL, OPTIONAL,  INTENT(IN) :: MAP_DEVPTR
+LOGICAL, OPTIONAL,  INTENT(IN) :: POOLED
 
 ALLOCATE (FIELD_OWNER)
 
 CALL FIELD_OWNER%INIT (LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=PERSISTENT, DELAYED=DELAYED, &
-&                      INIT_VALUE=INIT_VALUE, PINNED=PINNED, MAP_DEVPTR=MAP_DEVPTR)
+&                      INIT_VALUE=INIT_VALUE, PINNED=PINNED, MAP_DEVPTR=MAP_DEVPTR, POOLED=POOLED)
 
 FIELD_PTR => FIELD_OWNER
 

diff --git a/field_RANKSUFF_gang_module.fypp b/field_RANKSUFF_gang_module.fypp
@@ -159,7 +159,7 @@ CONTAINS
 
   END SUBROUTINE ${ftn}$_GANG_WRAPPER_INIT
 
-  SUBROUTINE ${ftn}$_GANG_OWNER_INIT(SELF, LBOUNDS, UBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR)
+  SUBROUTINE ${ftn}$_GANG_OWNER_INIT(SELF, LBOUNDS, UBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR, POOLED)
 
     USE FIELD_STATISTICS_MODULE
 
@@ -171,14 +171,15 @@ CONTAINS
     ${ft.type}$, OPTIONAL, INTENT(IN) :: INIT_VALUE
     LOGICAL, OPTIONAL,  INTENT(IN) :: PINNED
     LOGICAL, OPTIONAL,  INTENT(IN) :: MAP_DEVPTR
+    LOGICAL, OPTIONAL,  INTENT(IN) :: POOLED
 
     LOGICAL :: LLPERSISTENT
     INTEGER (KIND=JPIM) :: IFLR, JFLD, NFLD
     INTEGER (KIND=JPIM) :: LLBOUNDS (${ft.rank}$)
     CLASS (${ftn1}$_WRAPPER_HELPER), POINTER :: YLFW
 
     CALL SELF%${ftn}$_OWNER%INIT (PERSISTENT=PERSISTENT, LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, &
-        & DELAYED=.FALSE., INIT_VALUE=INIT_VALUE, PINNED=PINNED, MAP_DEVPTR=MAP_DEVPTR)
+        & DELAYED=.FALSE., INIT_VALUE=INIT_VALUE, PINNED=PINNED, MAP_DEVPTR=MAP_DEVPTR, POOLED=POOLED)
 
     LLBOUNDS = 1
     IF (PRESENT (LBOUNDS)) LLBOUNDS = LBOUNDS

diff --git a/field_RANKSUFF_module.fypp b/field_RANKSUFF_module.fypp
@@ -113,6 +113,7 @@ TYPE, EXTENDS(${ftn}$) :: ${ftn}$_OWNER
   INTEGER(KIND=JPIM) :: LBOUNDS(${ft.rank}$), UBOUNDS(${ft.rank}$)
   LOGICAL :: HAS_INIT_VALUE = .FALSE.
   LOGICAL :: PINNED = .FALSE.
+  LOGICAL :: POOLED = .FALSE.
   ${ft.type}$ :: INIT_VALUE
 CONTAINS
   PROCEDURE :: INIT => ${ftn}$_OWNER_INIT
@@ -210,7 +211,7 @@ CONTAINS
 
   END SUBROUTINE ${ftn}$_WRAPPER_INIT
 
-  SUBROUTINE ${ftn}$_OWNER_INIT (SELF, LBOUNDS, UBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR)
+  SUBROUTINE ${ftn}$_OWNER_INIT (SELF, LBOUNDS, UBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR, POOLED)
     USE FIELD_ABORT_MODULE 
     USE ${ftn}$_DATA_MODULE, ONLY : ${ftn}$_COPY_FUNC
 
@@ -221,6 +222,7 @@ CONTAINS
     LOGICAL, OPTIONAL,  INTENT(IN) :: DELAYED
     LOGICAL, OPTIONAL,  INTENT(IN) :: PINNED
     LOGICAL, OPTIONAL,  INTENT(IN) :: MAP_DEVPTR
+    LOGICAL, OPTIONAL,  INTENT(IN) :: POOLED
     ${ft.type}$, OPTIONAL, INTENT(IN) :: INIT_VALUE
     LOGICAL :: IS_DELAYED
     LOGICAL :: LLPERSISTENT
@@ -235,13 +237,16 @@ CONTAINS
     LLPERSISTENT = .FALSE.
     IF (PRESENT (PERSISTENT)) LLPERSISTENT = PERSISTENT
 
+    SELF%POOLED = POOL_OWNED_FIELDS
 #:if defined('CUDA')
-    ! In the presence of CUDA we pin by default
     SELF%PINNED = INIT_PINNED_VALUE
 #:endif
     IF(PRESENT(PINNED))THEN
       SELF%PINNED = PINNED
     ENDIF
+    IF(PRESENT(POOLED))THEN
+      SELF%POOLED = POOLED
+    ENDIF
 
     SELF%MAP_DEVPTR = INIT_MAP_DEVPTR
     IF(PRESENT(MAP_DEVPTR))THEN
@@ -292,7 +297,11 @@ CONTAINS
     ! Create FIELD object by explicitly allocating new data
     CLASS(${ftn}$_OWNER) :: SELF
 
-    CALL HOST_ALLOC(SELF%PTR, SELF%LBOUNDS, SELF%UBOUNDS, SELF%PINNED)
+    IF(SELF%POOLED)THEN
+       CALL HOST_ALLOC_POOLED(SELF%PTR, SELF%LBOUNDS, SELF%UBOUNDS, SELF%BLKID)
+    ELSE
+       CALL HOST_ALLOC(SELF%PTR, SELF%LBOUNDS, SELF%UBOUNDS, SELF%PINNED)
+    ENDIF
     CALL SELF%SET_STATUS (UNINITIALIZED)
   END SUBROUTINE ${ftn}$_OWNER_CREATE_HOST_DATA
 
@@ -359,7 +368,11 @@ CONTAINS
     CLASS(${ftn}$_OWNER) :: SELF
 
     IF(ASSOCIATED(SELF%PTR))THEN
-       CALL HOST_DEALLOC (SELF%PTR, SELF%PINNED)
+       IF(SELF%POOLED)THEN
+          CALL HOST_DEALLOC_POOLED (SELF%PTR, SELF%BLKID)
+       ELSE
+          CALL HOST_DEALLOC (SELF%PTR, SELF%PINNED)
+       ENDIF
     ENDIF
 
     CALL SELF%${ftn}$_FINAL

diff --git a/field_basic_module.F90 b/field_basic_module.F90
@@ -36,6 +36,7 @@ MODULE FIELD_BASIC_MODULE
 
   LOGICAL :: LOBJECT_COPIED = .FALSE.
   LOGICAL :: MAP_DEVPTR = .TRUE.
+  INTEGER(KIND=JPIM) :: BLKID = 0
 
 CONTAINS
   PROCEDURE (FIELD_BASIC_SYNC),   DEFERRED :: SYNC_HOST_RDWR

diff --git a/field_defaults_module.F90 b/field_defaults_module.F90
@@ -1,5 +1,6 @@
 MODULE FIELD_DEFAULTS_MODULE
   USE PARKIND1
+  USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : INT64
   LOGICAL :: USE_INIT_DEBUG_VALUE = .FALSE.
   REAL(KIND=JPRM) :: INIT_DEBUG_VALUE_JPRM = 0.0_JPRM
   REAL(KIND=JPRB) :: INIT_DEBUG_VALUE_JPRB = 0.0_JPRB
@@ -13,13 +14,18 @@ MODULE FIELD_DEFAULTS_MODULE
   LOGICAL :: INIT_INITIALIZED = .TRUE.
   LOGICAL :: INIT_MAP_DEVPTR = .TRUE.
   INTEGER :: GET_DEBUG_PRINT_LOCATION_DEPTH = 3
+  LOGICAL :: POOL_OWNED_FIELDS = .FALSE.
+  INTEGER :: POOL_ALLOC_PADDING_FACTOR = 8
+  INTEGER(KIND=INT64) :: POOL_BLOCK_SIZE = 2_INT64*1024_INT64*1024_INT64*1024_INT64 ! 2Gb
 
   NAMELIST / NAMFIELD_API / &
-   & USE_INIT_DEBUG_VALUE,  INIT_DEBUG_VALUE_JPRM,        &
-   & INIT_DEBUG_VALUE_JPRB, INIT_DEBUG_VALUE_JPRD,        &
-   & INIT_DEBUG_VALUE_JPIM, INIT_DEBUG_VALUE_JPLM,        &
-   & GET_DEBUG_PRINT_CRC,   GET_DEBUG_PRINT_LOCATION,     &
-   & INIT_PINNED_VALUE,     INIT_SYNC_ON_FINAL,           &
-   & INIT_MAP_DEVPTR,       GET_DEBUG_PRINT_LOCATION_DEPTH
+   & USE_INIT_DEBUG_VALUE,  INIT_DEBUG_VALUE_JPRM,          &
+   & INIT_DEBUG_VALUE_JPRB, INIT_DEBUG_VALUE_JPRD,          &
+   & INIT_DEBUG_VALUE_JPIM, INIT_DEBUG_VALUE_JPLM,          &
+   & GET_DEBUG_PRINT_CRC,   GET_DEBUG_PRINT_LOCATION,       &
+   & INIT_PINNED_VALUE,     INIT_SYNC_ON_FINAL,             &
+   & INIT_MAP_DEVPTR,       GET_DEBUG_PRINT_LOCATION_DEPTH, &
+   & POOL_OWNED_FIELDS,     POOL_ALLOC_PADDING_FACTOR,      &
+   & POOL_BLOCK_SIZE
 
 END MODULE FIELD_DEFAULTS_MODULE
diff --git a/field_factory_module.fypp b/field_factory_module.fypp
@@ -14,7 +14,14 @@ MODULE FIELD_FACTORY_MODULE
 #:for ft in fieldTypeList
 USE ${ft.name}$_FACTORY_MODULE
 #:endfor
+USE HOST_ALLOC_MODULE, ONLY : HOST_POOL
 
 IMPLICIT NONE
 
+CONTAINS
+
+SUBROUTINE FIELD_HOST_POOL_DELETE()
+   CALL HOST_POOL%FINAL()
+END SUBROUTINE FIELD_HOST_POOL_DELETE
+
 END MODULE