Field statistics

CMakeLists.txt

@@ -90,7 +90,7 @@ if( NOT fiat_FOUND )
   list(APPEND srcs ${ABOR1_PATH} ${OML_PATH} ${PARKIND1_PATH})
 endif()
 
-list(APPEND srcs field_basic_module.F90 field_defaults_module.F90 dev_alloc.c c_malloc.c field_constants_module.F90 field_abort_module.F90)
+list(APPEND srcs field_basic_module.F90 field_defaults_module.F90 dev_alloc.c c_malloc.c field_constants_module.F90 field_abort_module.F90 field_statistics_module.F90)
 
 ## check for CUDA
 include(CheckLanguage)

dev_alloc_module.fypp

@@ -98,6 +98,8 @@ END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST
 
 SUBROUTINE ${ft.name}$_DEV_ALLOCATE_DIM (DEV, UBOUNDS, LBOUNDS, MAP_DEVPTR)
 
+USE FIELD_STATISTICS_MODULE
+
 ${ft.type}$, POINTER :: DEV(${ft.shape}$)
 INTEGER (KIND=JPIM), INTENT (IN) :: UBOUNDS (${ft.rank}$)
 INTEGER (KIND=JPIM), INTENT (IN), OPTIONAL :: LBOUNDS (${ft.rank}$)
@@ -134,10 +136,14 @@ IF(MAP_DEVPTR)THEN
 !$acc enter data create (DEV)
 ENDIF
 
+IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_ALLOCATE (SIZE (DEV, KIND=JPIB) * INT (KIND (DEV), KIND=JPIB))
+
 END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_DIM
 
 SUBROUTINE ${ft.name}$_DEV_DEALLOCATE (DEV, MAP_DEVPTR)
 
+USE FIELD_STATISTICS_MODULE
+
 ${ft.type}$, POINTER :: DEV(${ft.shape}$)
 LOGICAL, INTENT(IN) :: MAP_DEVPTR
 TYPE (C_PTR) :: PTR
@@ -146,6 +152,9 @@ INTEGER :: ISTAT
 #:endif
 
 IF (ASSOCIATED (DEV)) THEN
+
+  IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_DEALLOCATE (SIZE (DEV, KIND=JPIB) * INT (KIND (DEV), KIND=JPIB))
+
   PTR = C_LOC (DEV (${ ', '.join (map (lambda i: 'LBOUND (DEV, ' + str (i) + ')', range (1, ft.rank+1))) }$))
 
   IF(MAP_DEVPTR)THEN
@@ -180,6 +189,8 @@ ALLOCATE (DEV, MOLD=HST)
 
 !$acc enter data create (DEV)
 
+IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_ALLOCATE (SIZE (DEV, KIND=JPIB) * INT (KIND (DEV), KIND=JPIB))
+
 END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST
 
 SUBROUTINE ${ft.name}$_DEV_DEALLOCATE (DEV, MAP_DEVPTR)
@@ -188,6 +199,9 @@ ${ft.type}$, POINTER :: DEV(${ft.shape}$)
 LOGICAL, INTENT(IN) :: MAP_DEVPTR
 
 IF (ASSOCIATED (DEV)) THEN
+
+  IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_DEALLOCATE (SIZE (DEV, KIND=JPIB) * INT (KIND (DEV), KIND=JPIB))
+
   !$acc exit data delete (DEV)
   DEALLOCATE (DEV)
   NULLIFY (DEV)

field_RANKSUFF_factory_module.fypp

@@ -53,6 +53,8 @@ CONTAINS
 #:for ft in fieldTypeList
 SUBROUTINE ${ft.name}$_NEW_OWNER (FIELD_PTR, UBOUNDS, LBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR)
 
+USE FIELD_STATISTICS_MODULE
+
 CLASS(${ft.name}$), POINTER :: FIELD_PTR
 TYPE(${ft.name}$_OWNER), POINTER :: FIELD_OWNER
 INTEGER(KIND=JPIM), INTENT(IN) :: UBOUNDS (${ft.rank}$)
@@ -70,10 +72,14 @@ CALL FIELD_OWNER%INIT (LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=PERSISTENT,
 
 FIELD_PTR => FIELD_OWNER
 
+IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_NEW ()
+
 END SUBROUTINE
 
 SUBROUTINE ${ft.name}$_NEW_WRAPPER (FIELD_PTR, LBOUNDS, PERSISTENT, DATA, MAP_DEVPTR, SYNC_ON_FINAL)
 
+USE FIELD_STATISTICS_MODULE
+
 CLASS(${ft.name}$), POINTER :: FIELD_PTR
 ${ft.type}$, TARGET, INTENT (IN) :: DATA (${ft.shape}$)
 TYPE(${ft.name}$_WRAPPER), POINTER :: FIELD_WRAPPER
@@ -88,11 +94,15 @@ CALL FIELD_WRAPPER%INIT (DATA, LBOUNDS=LBOUNDS, PERSISTENT=PERSISTENT, MAP_DEVPT
 
 FIELD_PTR => FIELD_WRAPPER
 
+IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_NEW ()
+
 END SUBROUTINE
 
 #:if ft.ganged
 SUBROUTINE ${ft.name}$_NEW_GANG_WRAPPER (FIELD_PTR, CHILDREN, LBOUNDS, PERSISTENT, DATA, SYNC_ON_FINAL)
 
+USE FIELD_STATISTICS_MODULE
+
 #:set fieldTypeList1 = fieldType.getFieldTypeList (ranks=[ft.rank-1], kinds=[ft.kind])
 #:set ft1 = fieldTypeList1[0]
 
@@ -119,10 +129,14 @@ DO JFLD = 1, SIZE (CHILDREN)
   FIELD_GANG%CHILDREN (JFLD)%PTR%PARENT => FIELD_PTR
 ENDDO
 
+IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_NEW ()
+
 END SUBROUTINE
 
 SUBROUTINE ${ft.name}$_NEW_GANG_OWNER (FIELD_PTR, CHILDREN, UBOUNDS, LBOUNDS, PERSISTENT, DELAYED, INIT_VALUE)
 
+USE FIELD_STATISTICS_MODULE
+
 #:set fieldTypeList1 = fieldType.getFieldTypeList (ranks=[ft.rank-1], kinds=[ft.kind])
 #:set ft1 = fieldTypeList1[0]
 
@@ -150,14 +164,20 @@ DO JFLD = 1, SIZE (CHILDREN)
   FIELD_GANG%CHILDREN (JFLD)%PTR%PARENT => FIELD_PTR
 ENDDO
 
+IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_NEW ()
+
 END SUBROUTINE
 
 #:endif
 
 SUBROUTINE ${ft.name}$_DELETE (FIELD_PTR)
 
+USE FIELD_STATISTICS_MODULE
+
 CLASS(${ft.name}$), POINTER :: FIELD_PTR
 
+IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DELETE ()
+
 CALL FIELD_PTR%FINAL ()
 DEALLOCATE (FIELD_PTR)
 NULLIFY (FIELD_PTR)

field_RANKSUFF_gang_module.fypp

@@ -115,6 +115,9 @@ CONTAINS
 #:endfor
 
   SUBROUTINE ${ftn}$_GANG_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR, SYNC_ON_FINAL)
+
+    USE FIELD_STATISTICS_MODULE
+
     CLASS(${ftn}$_GANG_WRAPPER) :: SELF
     ${ft.type}$, TARGET, INTENT(IN) :: DATA(${ft.shape}$)
     LOGICAL, INTENT(IN), OPTIONAL :: PERSISTENT
@@ -143,6 +146,9 @@ CONTAINS
 
     DO JFLD = 1, NFLD
       ALLOCATE (YLFW)
+
+      IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_NEW ()
+
       CALL YLFW%INIT (DATA=DATA(${ar}$, JFLD, :), PERSISTENT=PERSISTENT, LBOUNDS=LLBOUNDS(1:IFLR), MAP_DEVPTR=MAP_DEVPTR, SYNC_ON_FINAL=SYNC_ON_FINAL)
       SELF%CHILDREN (JFLD)%PTR => YLFW
       CALL SELF%CHILDREN(JFLD)%PTR%SET_STATUS (SELF%GET_STATUS ())
@@ -151,6 +157,9 @@ CONTAINS
   END SUBROUTINE ${ftn}$_GANG_WRAPPER_INIT
 
   SUBROUTINE ${ftn}$_GANG_OWNER_INIT(SELF, LBOUNDS, UBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR)
+
+    USE FIELD_STATISTICS_MODULE
+
     CLASS(${ftn}$_GANG_OWNER) :: SELF
     INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: LBOUNDS(${ft.rank}$)
     INTEGER(KIND=JPIM), INTENT(IN) :: UBOUNDS(${ft.rank}$)
@@ -182,6 +191,9 @@ CONTAINS
 
     DO JFLD = 1, NFLD
       ALLOCATE (YLFW)
+
+      IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_NEW ()
+
       CALL YLFW%INIT (DATA=SELF%PTR (${ar}$, JFLD, :), PERSISTENT=PERSISTENT, LBOUNDS=LLBOUNDS(1:IFLR), SYNC_ON_FINAL=.FALSE.)
       SELF%CHILDREN (JFLD)%PTR => YLFW
       CALL SELF%CHILDREN(JFLD)%PTR%SET_STATUS (SELF%GET_STATUS ())
@@ -191,12 +203,18 @@ CONTAINS
 
 #:for type in ['WRAPPER', 'OWNER']
   SUBROUTINE ${ftn}$_GANG_${type}$_FINAL(SELF)
+
+    USE FIELD_STATISTICS_MODULE
+
     CLASS(${ftn}$_GANG_${type}$) :: SELF
     ${ft.type}$, POINTER :: PTR(${ft.shape}$)
     INTEGER (KIND=JPIM) :: JFLD
     CLASS (${ftn1}$_WRAPPER_HELPER), POINTER :: YLF
 
     DO JFLD = 1, SIZE (SELF%CHILDREN)
+
+      IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DELETE ()
+
       YLF => SELF%CHILDREN(JFLD)%PTR
       NULLIFY (YLF%DEVPTR)
       NULLIFY (YLF%PARENT)

field_statistics_module.F90

@@ -0,0 +1,70 @@
+MODULE FIELD_STATISTICS_MODULE
+
+USE PARKIND1, ONLY : JPIB, JPIM
+
+IMPLICIT NONE
+
+TYPE FIELD_STATISTICS_TYPE
+  INTEGER (KIND=JPIB) :: MEMORY_HOST_CUR = 0
+  INTEGER (KIND=JPIB) :: MEMORY_HOST_MAX = 0
+
+  INTEGER (KIND=JPIB) :: MEMORY_DEVICE_CUR = 0
+  INTEGER (KIND=JPIB) :: MEMORY_DEVICE_MAX = 0
+
+  INTEGER (KIND=JPIB) :: NFIELDS_CUR = 0
+  INTEGER (KIND=JPIB) :: NFIELDS_MAX = 0
+END TYPE
+
+LOGICAL, SAVE :: FIELD_STATISTICS_ENABLE = .FALSE.
+TYPE (FIELD_STATISTICS_TYPE), SAVE :: FIELD_STATISTICS
+
+CONTAINS
+
+SUBROUTINE FIELD_STATISTICS_NEW () 
+
+FIELD_STATISTICS%NFIELDS_CUR = FIELD_STATISTICS%NFIELDS_CUR+1
+FIELD_STATISTICS%NFIELDS_MAX = MAX(FIELD_STATISTICS%NFIELDS_CUR,FIELD_STATISTICS%NFIELDS_MAX)
+
+END SUBROUTINE 
+
+SUBROUTINE FIELD_STATISTICS_DELETE () 
+
+FIELD_STATISTICS%NFIELDS_CUR = FIELD_STATISTICS%NFIELDS_CUR-1
+
+END SUBROUTINE 
+
+SUBROUTINE FIELD_STATISTICS_HOST_ALLOCATE (KSIZE) 
+
+INTEGER (KIND=JPIB), INTENT (IN) :: KSIZE
+
+FIELD_STATISTICS%MEMORY_HOST_CUR = FIELD_STATISTICS%MEMORY_HOST_CUR+KSIZE
+FIELD_STATISTICS%MEMORY_HOST_MAX = MAX(FIELD_STATISTICS%MEMORY_HOST_CUR,FIELD_STATISTICS%MEMORY_HOST_MAX)
+
+END SUBROUTINE 
+
+SUBROUTINE FIELD_STATISTICS_HOST_DEALLOCATE (KSIZE) 
+
+INTEGER (KIND=JPIB), INTENT (IN) :: KSIZE
+
+FIELD_STATISTICS%MEMORY_HOST_CUR = FIELD_STATISTICS%MEMORY_HOST_CUR-KSIZE
+
+END SUBROUTINE 
+
+SUBROUTINE FIELD_STATISTICS_DEVICE_ALLOCATE (KSIZE) 
+
+INTEGER (KIND=JPIB), INTENT (IN) :: KSIZE
+
+FIELD_STATISTICS%MEMORY_DEVICE_CUR = FIELD_STATISTICS%MEMORY_DEVICE_CUR+KSIZE
+FIELD_STATISTICS%MEMORY_DEVICE_MAX = MAX(FIELD_STATISTICS%MEMORY_DEVICE_CUR,FIELD_STATISTICS%MEMORY_DEVICE_MAX)
+
+END SUBROUTINE 
+
+SUBROUTINE FIELD_STATISTICS_DEVICE_DEALLOCATE (KSIZE) 
+
+INTEGER (KIND=JPIB), INTENT (IN) :: KSIZE
+
+FIELD_STATISTICS%MEMORY_DEVICE_CUR = FIELD_STATISTICS%MEMORY_DEVICE_CUR-KSIZE
+
+END SUBROUTINE 
+
+END MODULE

host_alloc_module.fypp

@@ -52,6 +52,9 @@ CONTAINS
 
 #:for ft in fieldTypeList
 SUBROUTINE ${ft.name}$_HOST_ALLOC (HST, LBOUNDS, UBOUNDS, PINNED)
+
+   USE FIELD_STATISTICS_MODULE
+
    USE FIELD_ABORT_MODULE
 
    ${ft.type}$, POINTER, INTENT(OUT) :: HST(${ft.shape}$)
@@ -89,10 +92,14 @@ SUBROUTINE ${ft.name}$_HOST_ALLOC (HST, LBOUNDS, UBOUNDS, PINNED)
      ALLOCATE(HST(${','.join([f'LBOUNDS({r+1}):UBOUNDS({r+1})' for r in range(ft.rank)])}$))
    ENDIF
 
+   IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_HOST_ALLOCATE (SIZE (HST, KIND=JPIB) * INT (KIND (HST), KIND=JPIB))
+
 END SUBROUTINE ${ft.name}$_HOST_ALLOC
 
 SUBROUTINE ${ft.name}$_HOST_DEALLOC(HST, PINNED)
 
+   USE FIELD_STATISTICS_MODULE
+
    USE FIELD_ABORT_MODULE
 
    ${ft.type}$, POINTER, INTENT(INOUT) :: HST(${ft.shape}$)
@@ -101,6 +108,8 @@ SUBROUTINE ${ft.name}$_HOST_DEALLOC(HST, PINNED)
    TYPE(C_PTR) :: DATA
    INTEGER :: ISTAT
 
+   IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_HOST_DEALLOCATE (SIZE (HST, KIND=JPIB) * INT (KIND (HST), KIND=JPIB))
+
    IF(SIZE(HST) > 0)THEN
      DATA = C_LOC (HST (${ ', '.join (map (lambda i: 'LBOUND (HST, ' + str (i) + ')', range (1, ft.rank+1))) }$))
 

tests/CMakeLists.txt

@@ -25,6 +25,7 @@ target_compile_definitions( main.x PRIVATE $<${HAVE_CUDA}:_CUDA> )
 
 ## Unit tests
 list(APPEND TEST_FILES
+        test_statistics.F90
         test_sizeof.F90
         test_bc.F90
         reshuffle.F90

tests/test_statistics.F90

@@ -0,0 +1,70 @@
+! (C) Copyright 2022- ECMWF.
+! (C) Copyright 2022- Meteo-France.
+! (C) Copyright 2023- NVIDIA
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+PROGRAM TEST_STATISTICS
+
+USE FIELD_ABORT_MODULE
+USE FIELD_STATISTICS_MODULE
+USE FIELD_MODULE
+USE PARKIND1
+USE FIELD_FACTORY_MODULE
+USE FIELD_ACCESS_MODULE
+
+IMPLICIT NONE
+CLASS(FIELD_4IM), POINTER :: YLF1 => NULL(), YLF2 => NULL ()
+INTEGER (KIND=JPIM) :: UBOUNDS (4) = [2,10,10,10]
+INTEGER (KIND=JPIM) :: IDATA0 (5,3,2,9)
+INTEGER (KIND=JPIM), POINTER :: IDATA (:,:,:,:)
+
+FIELD_STATISTICS_ENABLE = .TRUE.
+
+CALL FIELD_NEW (YLF1, UBOUNDS=UBOUNDS, PERSISTENT=.TRUE.)
+
+CALL ASSERT (FIELD_STATISTICS%NFIELDS_CUR==1)
+
+CALL FIELD_NEW (YLF2, DATA=IDATA0, PERSISTENT=.TRUE.)
+
+CALL ASSERT (FIELD_STATISTICS%NFIELDS_CUR==2)
+
+CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==0)
+
+IDATA => GET_DEVICE_DATA_RDONLY (YLF1)
+
+CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==INT(KIND(IDATA),JPIB)*SIZE(IDATA,KIND=JPIB))
+
+IDATA => GET_DEVICE_DATA_RDONLY (YLF2)
+
+CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==INT(JPIM,JPIB)*PRODUCT(INT(UBOUNDS,JPIB))+INT(JPIM,JPIB)*SIZE(IDATA0,KIND=JPIB))
+
+CALL FIELD_DELETE (YLF1)
+
+CALL ASSERT (FIELD_STATISTICS%NFIELDS_CUR==1)
+
+CALL FIELD_DELETE (YLF2)
+
+CALL ASSERT (FIELD_STATISTICS%NFIELDS_CUR==0)
+
+CALL ASSERT (FIELD_STATISTICS%NFIELDS_MAX==2)
+
+CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==0)
+
+CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_MAX==PRODUCT(INT(UBOUNDS,JPIB))*INT(JPIM,JPIB)+SIZE(IDATA0,KIND=JPIB)*INT(JPIM,JPIB))
+
+CONTAINS 
+
+SUBROUTINE ASSERT (LDCOND)
+
+LOGICAL :: LDCOND
+
+IF (.NOT. LDCOND) CALL FIELD_ABORT ('UNEXPECTED VALUE')
+
+END SUBROUTINE
+
+END PROGRAM