From 4c9d08ff4079390d78a9e4615024dbe1faeb1521 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Fri, 29 Mar 2024 16:45:54 +0000 Subject: [PATCH 1/5] Add field_stat_module.F90 & field_stat.h and use them in allocate/deallocate --- CMakeLists.txt | 2 +- dev_alloc_module.fypp | 14 ++++++++++++++ field_stat.h | 13 +++++++++++++ field_stat_module.F90 | 22 ++++++++++++++++++++++ host_alloc_module.fypp | 9 +++++++++ 5 files changed, 59 insertions(+), 1 deletion(-) create mode 100644 field_stat.h create mode 100644 field_stat_module.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 202a903..65d73b5 100644 --- a/CMakeLists.txt +++ b/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_stat_module.F90) ## check for CUDA include(CheckLanguage) diff --git a/dev_alloc_module.fypp b/dev_alloc_module.fypp index 4668c33..73de925 100644 --- a/dev_alloc_module.fypp +++ b/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) +#include "field_stat.h" + ${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 +field_stat_device_allocate (DEV) + END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_DIM SUBROUTINE ${ft.name}$_DEV_DEALLOCATE (DEV, MAP_DEVPTR) +#include "field_stat.h" + ${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 + + field_stat_device_deallocate (DEV) + 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) +field_stat_device_allocate (DEV) + 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 + + field_stat_device_deallocate (DEV) + !$acc exit data delete (DEV) DEALLOCATE (DEV) NULLIFY (DEV) diff --git a/field_stat.h b/field_stat.h new file mode 100644 index 0000000..bac9d16 --- /dev/null +++ b/field_stat.h @@ -0,0 +1,13 @@ + +USE FIELD_STAT_MODULE, ONLY : FS => FIELD_STATISTICS, FE => FIELD_STAT_ENABLE + +#define field_stat_new() IF(FE)THEN;FS%NFIELDS_CUR=FS%NFIELDS_CUR+1;FS%NFIELDS_MAX=MAX(FS%NFIELDS_CUR,FS%NFIELDS_MAX);ENDIF +#define field_stat_delete() IF(FE)THEN;FS%NFIELDS_CUR=FS%NFIELDS_CUR-1;ENDIF + +#define field_stat_host_allocate(p) IF(FE)THEN;FS%MEMORY_HOST_CUR=FS%MEMORY_HOST_CUR+SIZE(p)*KIND(p);FS%MEMORY_HOST_MAX=MAX(FS%MEMORY_HOST_CUR,FS%MEMORY_HOST_MAX);ENDIF +#define field_stat_host_deallocate(p) IF(FE)THEN;FS%MEMORY_HOST_CUR=FS%MEMORY_HOST_CUR-SIZE(p)*KIND(p);ENDIF + +#define field_stat_device_allocate(p) IF(FE)THEN;FS%MEMORY_DEVICE_CUR=FS%MEMORY_DEVICE_CUR+SIZE(p)*KIND(p);FS%MEMORY_DEVICE_MAX=MAX(FS%MEMORY_DEVICE_CUR,FS%MEMORY_DEVICE_MAX);ENDIF +#define field_stat_device_deallocate(p) IF(FE)THEN;FS%MEMORY_DEVICE_CUR=FS%MEMORY_DEVICE_CUR-SIZE(p)*KIND(p);ENDIF + + diff --git a/field_stat_module.F90 b/field_stat_module.F90 new file mode 100644 index 0000000..f1122f6 --- /dev/null +++ b/field_stat_module.F90 @@ -0,0 +1,22 @@ +MODULE FIELD_STAT_MODULE + +USE PARKIND1, ONLY : JPIB + +IMPLICIT NONE + +TYPE FIELD_STAT + 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_STAT_ENABLE = .FALSE. + +TYPE (FIELD_STAT), SAVE :: FIELD_STATISTICS + +END MODULE diff --git a/host_alloc_module.fypp b/host_alloc_module.fypp index 1faaaf1..0437beb 100644 --- a/host_alloc_module.fypp +++ b/host_alloc_module.fypp @@ -52,6 +52,9 @@ CONTAINS #:for ft in fieldTypeList SUBROUTINE ${ft.name}$_HOST_ALLOC (HST, LBOUNDS, UBOUNDS, PINNED) + +#include "field_stat.h" + 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 + field_stat_host_allocate (HST) + END SUBROUTINE ${ft.name}$_HOST_ALLOC SUBROUTINE ${ft.name}$_HOST_DEALLOC(HST, PINNED) +#include "field_stat.h" + 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 + field_stat_host_deallocate (HST) + IF(SIZE(HST) > 0)THEN DATA = C_LOC (HST (${ ', '.join (map (lambda i: 'LBOUND (HST, ' + str (i) + ')', range (1, ft.rank+1))) }$)) From 7bb648a83391ca0c7d05bb6208abf0a782e95069 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Fri, 29 Mar 2024 17:43:55 +0000 Subject: [PATCH 2/5] Add test case for statistics --- CMakeLists.txt | 2 +- dev_alloc_module.fypp | 12 ++-- field_RANKSUFF_factory_module.fypp | 20 ++++++ field_RANKSUFF_gang_module.fypp | 18 ++++++ field_stat.h | 13 ---- field_statistics.h | 13 ++++ ..._module.F90 => field_statistics_module.F90 | 11 ++-- host_alloc_module.fypp | 8 +-- tests/CMakeLists.txt | 1 + tests/test_statistics.F90 | 62 +++++++++++++++++++ 10 files changed, 132 insertions(+), 28 deletions(-) delete mode 100644 field_stat.h create mode 100644 field_statistics.h rename field_stat_module.F90 => field_statistics_module.F90 (59%) create mode 100644 tests/test_statistics.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 65d73b5..f8072f0 100644 --- a/CMakeLists.txt +++ b/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 field_stat_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) diff --git a/dev_alloc_module.fypp b/dev_alloc_module.fypp index 73de925..6bd17ac 100644 --- a/dev_alloc_module.fypp +++ b/dev_alloc_module.fypp @@ -98,7 +98,7 @@ END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST SUBROUTINE ${ft.name}$_DEV_ALLOCATE_DIM (DEV, UBOUNDS, LBOUNDS, MAP_DEVPTR) -#include "field_stat.h" +#include "field_statistics.h" ${ft.type}$, POINTER :: DEV(${ft.shape}$) INTEGER (KIND=JPIM), INTENT (IN) :: UBOUNDS (${ft.rank}$) @@ -136,13 +136,13 @@ IF(MAP_DEVPTR)THEN !$acc enter data create (DEV) ENDIF -field_stat_device_allocate (DEV) +field_statistics_device_allocate (DEV) END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_DIM SUBROUTINE ${ft.name}$_DEV_DEALLOCATE (DEV, MAP_DEVPTR) -#include "field_stat.h" +#include "field_statistics.h" ${ft.type}$, POINTER :: DEV(${ft.shape}$) LOGICAL, INTENT(IN) :: MAP_DEVPTR @@ -153,7 +153,7 @@ INTEGER :: ISTAT IF (ASSOCIATED (DEV)) THEN - field_stat_device_deallocate (DEV) + field_statistics_device_deallocate (DEV) PTR = C_LOC (DEV (${ ', '.join (map (lambda i: 'LBOUND (DEV, ' + str (i) + ')', range (1, ft.rank+1))) }$)) @@ -189,7 +189,7 @@ ALLOCATE (DEV, MOLD=HST) !$acc enter data create (DEV) -field_stat_device_allocate (DEV) +field_statistics_device_allocate (DEV) END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST @@ -200,7 +200,7 @@ LOGICAL, INTENT(IN) :: MAP_DEVPTR IF (ASSOCIATED (DEV)) THEN - field_stat_device_deallocate (DEV) + field_statistics_device_deallocate (DEV) !$acc exit data delete (DEV) DEALLOCATE (DEV) diff --git a/field_RANKSUFF_factory_module.fypp b/field_RANKSUFF_factory_module.fypp index dfc492c..380a32b 100644 --- a/field_RANKSUFF_factory_module.fypp +++ b/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) +#include "field_statistics.h" + 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 +field_statistics_new () + END SUBROUTINE SUBROUTINE ${ft.name}$_NEW_WRAPPER (FIELD_PTR, LBOUNDS, PERSISTENT, DATA, MAP_DEVPTR, SYNC_ON_FINAL) +#include "field_statistics.h" + 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 +field_statistics_new () + END SUBROUTINE #:if ft.ganged SUBROUTINE ${ft.name}$_NEW_GANG_WRAPPER (FIELD_PTR, CHILDREN, LBOUNDS, PERSISTENT, DATA, SYNC_ON_FINAL) +#include "field_statistics.h" + #: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 +field_statistics_new () + END SUBROUTINE SUBROUTINE ${ft.name}$_NEW_GANG_OWNER (FIELD_PTR, CHILDREN, UBOUNDS, LBOUNDS, PERSISTENT, DELAYED, INIT_VALUE) +#include "field_statistics.h" + #: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 +field_statistics_new () + END SUBROUTINE #:endif SUBROUTINE ${ft.name}$_DELETE (FIELD_PTR) +#include "field_statistics.h" + CLASS(${ft.name}$), POINTER :: FIELD_PTR +field_statistics_delete () + CALL FIELD_PTR%FINAL () DEALLOCATE (FIELD_PTR) NULLIFY (FIELD_PTR) diff --git a/field_RANKSUFF_gang_module.fypp b/field_RANKSUFF_gang_module.fypp index 9571f1e..7084fe6 100644 --- a/field_RANKSUFF_gang_module.fypp +++ b/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) + +#include "field_statistics.h" + 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) + + 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) + +#include "field_statistics.h" + 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) + + 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) + +#include "field_statistics.h" + 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) + + field_statistics_delete () + YLF => SELF%CHILDREN(JFLD)%PTR NULLIFY (YLF%DEVPTR) NULLIFY (YLF%PARENT) diff --git a/field_stat.h b/field_stat.h deleted file mode 100644 index bac9d16..0000000 --- a/field_stat.h +++ /dev/null @@ -1,13 +0,0 @@ - -USE FIELD_STAT_MODULE, ONLY : FS => FIELD_STATISTICS, FE => FIELD_STAT_ENABLE - -#define field_stat_new() IF(FE)THEN;FS%NFIELDS_CUR=FS%NFIELDS_CUR+1;FS%NFIELDS_MAX=MAX(FS%NFIELDS_CUR,FS%NFIELDS_MAX);ENDIF -#define field_stat_delete() IF(FE)THEN;FS%NFIELDS_CUR=FS%NFIELDS_CUR-1;ENDIF - -#define field_stat_host_allocate(p) IF(FE)THEN;FS%MEMORY_HOST_CUR=FS%MEMORY_HOST_CUR+SIZE(p)*KIND(p);FS%MEMORY_HOST_MAX=MAX(FS%MEMORY_HOST_CUR,FS%MEMORY_HOST_MAX);ENDIF -#define field_stat_host_deallocate(p) IF(FE)THEN;FS%MEMORY_HOST_CUR=FS%MEMORY_HOST_CUR-SIZE(p)*KIND(p);ENDIF - -#define field_stat_device_allocate(p) IF(FE)THEN;FS%MEMORY_DEVICE_CUR=FS%MEMORY_DEVICE_CUR+SIZE(p)*KIND(p);FS%MEMORY_DEVICE_MAX=MAX(FS%MEMORY_DEVICE_CUR,FS%MEMORY_DEVICE_MAX);ENDIF -#define field_stat_device_deallocate(p) IF(FE)THEN;FS%MEMORY_DEVICE_CUR=FS%MEMORY_DEVICE_CUR-SIZE(p)*KIND(p);ENDIF - - diff --git a/field_statistics.h b/field_statistics.h new file mode 100644 index 0000000..4c89942 --- /dev/null +++ b/field_statistics.h @@ -0,0 +1,13 @@ + +USE FIELD_STATISTICS_MODULE, ONLY : FS => FIELD_STATISTICS, FE => FIELD_STATISTICS_ENABLE + +#define field_statistics_new() IF(FE)THEN;FS%NFIELDS_CUR=FS%NFIELDS_CUR+1;FS%NFIELDS_MAX=MAX(FS%NFIELDS_CUR,FS%NFIELDS_MAX);ENDIF +#define field_statistics_delete() IF(FE)THEN;FS%NFIELDS_CUR=FS%NFIELDS_CUR-1;ENDIF + +#define field_statistics_host_allocate(p) IF(FE)THEN;FS%MEMORY_HOST_CUR=FS%MEMORY_HOST_CUR+SIZE(p)*KIND(p);FS%MEMORY_HOST_MAX=MAX(FS%MEMORY_HOST_CUR,FS%MEMORY_HOST_MAX);ENDIF +#define field_statistics_host_deallocate(p) IF(FE)THEN;FS%MEMORY_HOST_CUR=FS%MEMORY_HOST_CUR-SIZE(p)*KIND(p);ENDIF + +#define field_statistics_device_allocate(p) IF(FE)THEN;FS%MEMORY_DEVICE_CUR=FS%MEMORY_DEVICE_CUR+SIZE(p)*KIND(p);FS%MEMORY_DEVICE_MAX=MAX(FS%MEMORY_DEVICE_CUR,FS%MEMORY_DEVICE_MAX);ENDIF +#define field_statistics_device_deallocate(p) IF(FE)THEN;FS%MEMORY_DEVICE_CUR=FS%MEMORY_DEVICE_CUR-SIZE(p)*KIND(p);ENDIF + + diff --git a/field_stat_module.F90 b/field_statistics_module.F90 similarity index 59% rename from field_stat_module.F90 rename to field_statistics_module.F90 index f1122f6..e9952df 100644 --- a/field_stat_module.F90 +++ b/field_statistics_module.F90 @@ -1,10 +1,10 @@ -MODULE FIELD_STAT_MODULE +MODULE FIELD_STATISTICS_MODULE USE PARKIND1, ONLY : JPIB IMPLICIT NONE -TYPE FIELD_STAT +TYPE FIELD_STATISTICS_TYPE INTEGER (KIND=JPIB) :: MEMORY_HOST_CUR = 0 INTEGER (KIND=JPIB) :: MEMORY_HOST_MAX = 0 @@ -15,8 +15,11 @@ MODULE FIELD_STAT_MODULE INTEGER (KIND=JPIB) :: NFIELDS_MAX = 0 END TYPE -LOGICAL, SAVE :: FIELD_STAT_ENABLE = .FALSE. +PRIVATE -TYPE (FIELD_STAT), SAVE :: FIELD_STATISTICS +LOGICAL, SAVE :: FIELD_STATISTICS_ENABLE = .FALSE. +TYPE (FIELD_STATISTICS_TYPE), SAVE :: FIELD_STATISTICS + +PUBLIC :: FIELD_STATISTICS, FIELD_STATISTICS_ENABLE END MODULE diff --git a/host_alloc_module.fypp b/host_alloc_module.fypp index 0437beb..d9e6e8d 100644 --- a/host_alloc_module.fypp +++ b/host_alloc_module.fypp @@ -53,7 +53,7 @@ CONTAINS #:for ft in fieldTypeList SUBROUTINE ${ft.name}$_HOST_ALLOC (HST, LBOUNDS, UBOUNDS, PINNED) -#include "field_stat.h" +#include "field_statistics.h" USE FIELD_ABORT_MODULE @@ -92,13 +92,13 @@ 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 - field_stat_host_allocate (HST) + field_statistics_host_allocate (HST) END SUBROUTINE ${ft.name}$_HOST_ALLOC SUBROUTINE ${ft.name}$_HOST_DEALLOC(HST, PINNED) -#include "field_stat.h" +#include "field_statistics.h" USE FIELD_ABORT_MODULE @@ -108,7 +108,7 @@ SUBROUTINE ${ft.name}$_HOST_DEALLOC(HST, PINNED) TYPE(C_PTR) :: DATA INTEGER :: ISTAT - field_stat_host_deallocate (HST) + field_statistics_host_deallocate (HST) IF(SIZE(HST) > 0)THEN DATA = C_LOC (HST (${ ', '.join (map (lambda i: 'LBOUND (HST, ' + str (i) + ')', range (1, ft.rank+1))) }$)) diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index e5a7b56..0784212 100644 --- a/tests/CMakeLists.txt +++ b/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 diff --git a/tests/test_statistics.F90 b/tests/test_statistics.F90 new file mode 100644 index 0000000..41080cd --- /dev/null +++ b/tests/test_statistics.F90 @@ -0,0 +1,62 @@ +! (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) = [4,4,2,7] +INTEGER (KIND=JPIM) :: IDATA0 (5,3,2,9) +INTEGER (KIND=JPIM), POINTER :: IDATA (:,:,:,:) + +#define assert(cond) IF (.NOT.(cond)) CALL FIELD_ABORT ("'"//#cond//"' IS FALSE") + +FIELD_STATISTICS_ENABLE = .TRUE. + +CALL FIELD_NEW (YLF1, UBOUNDS=UBOUNDS, PERSISTENT=.TRUE.) + +assert (FIELD_STATISTICS%NFIELDS_CUR==1) + +CALL FIELD_NEW (YLF2, DATA=IDATA0, PERSISTENT=.TRUE.) + +assert (FIELD_STATISTICS%NFIELDS_CUR==2) + +assert (FIELD_STATISTICS%MEMORY_DEVICE_CUR==0) + +IDATA => GET_DEVICE_DATA_RDONLY (YLF1) + +assert (FIELD_STATISTICS%MEMORY_DEVICE_CUR==KIND(IDATA)*SIZE(IDATA)) + +IDATA => GET_DEVICE_DATA_RDONLY (YLF2) + +assert (FIELD_STATISTICS%MEMORY_DEVICE_CUR==JPIM*PRODUCT(UBOUNDS)+JPIM*SIZE(IDATA0)) + +CALL FIELD_DELETE (YLF1) + +assert (FIELD_STATISTICS%NFIELDS_CUR==1) + +CALL FIELD_DELETE (YLF2) + +assert (FIELD_STATISTICS%NFIELDS_CUR==0) + +assert (FIELD_STATISTICS%NFIELDS_MAX==2) + +assert (FIELD_STATISTICS%MEMORY_DEVICE_CUR==0) + +assert (FIELD_STATISTICS%MEMORY_DEVICE_MAX==PRODUCT(UBOUNDS)*JPIM+SIZE(IDATA0)*JPIM) + +END PROGRAM From c5f22ea0768f66c5752e51659c40c77806f98eaa Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Sun, 31 Mar 2024 14:59:41 +0000 Subject: [PATCH 3/5] Do not use cpp macros (not supported by gfortran) --- dev_alloc_module.fypp | 12 +++---- field_RANKSUFF_factory_module.fypp | 20 +++++------ field_RANKSUFF_gang_module.fypp | 12 +++---- field_statistics.h | 13 -------- field_statistics_module.F90 | 53 +++++++++++++++++++++++++++--- host_alloc_module.fypp | 8 ++--- tests/test_statistics.F90 | 32 +++++++++++------- 7 files changed, 95 insertions(+), 55 deletions(-) delete mode 100644 field_statistics.h diff --git a/dev_alloc_module.fypp b/dev_alloc_module.fypp index 6bd17ac..bb7d79d 100644 --- a/dev_alloc_module.fypp +++ b/dev_alloc_module.fypp @@ -98,7 +98,7 @@ END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST SUBROUTINE ${ft.name}$_DEV_ALLOCATE_DIM (DEV, UBOUNDS, LBOUNDS, MAP_DEVPTR) -#include "field_statistics.h" +USE FIELD_STATISTICS_MODULE ${ft.type}$, POINTER :: DEV(${ft.shape}$) INTEGER (KIND=JPIM), INTENT (IN) :: UBOUNDS (${ft.rank}$) @@ -136,13 +136,13 @@ IF(MAP_DEVPTR)THEN !$acc enter data create (DEV) ENDIF -field_statistics_device_allocate (DEV) +IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_ALLOCATE (SIZE (DEV) * KIND (DEV)) END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_DIM SUBROUTINE ${ft.name}$_DEV_DEALLOCATE (DEV, MAP_DEVPTR) -#include "field_statistics.h" +USE FIELD_STATISTICS_MODULE ${ft.type}$, POINTER :: DEV(${ft.shape}$) LOGICAL, INTENT(IN) :: MAP_DEVPTR @@ -153,7 +153,7 @@ INTEGER :: ISTAT IF (ASSOCIATED (DEV)) THEN - field_statistics_device_deallocate (DEV) + IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_DEALLOCATE (SIZE (DEV) * KIND (DEV)) PTR = C_LOC (DEV (${ ', '.join (map (lambda i: 'LBOUND (DEV, ' + str (i) + ')', range (1, ft.rank+1))) }$)) @@ -189,7 +189,7 @@ ALLOCATE (DEV, MOLD=HST) !$acc enter data create (DEV) -field_statistics_device_allocate (DEV) +IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_ALLOCATE (SIZE (DEV) * KIND (DEV)) END SUBROUTINE ${ft.name}$_DEV_ALLOCATE_HST @@ -200,7 +200,7 @@ LOGICAL, INTENT(IN) :: MAP_DEVPTR IF (ASSOCIATED (DEV)) THEN - field_statistics_device_deallocate (DEV) + IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_DEALLOCATE (SIZE (DEV) * KIND (DEV)) !$acc exit data delete (DEV) DEALLOCATE (DEV) diff --git a/field_RANKSUFF_factory_module.fypp b/field_RANKSUFF_factory_module.fypp index 380a32b..2ef2373 100644 --- a/field_RANKSUFF_factory_module.fypp +++ b/field_RANKSUFF_factory_module.fypp @@ -53,7 +53,7 @@ CONTAINS #:for ft in fieldTypeList SUBROUTINE ${ft.name}$_NEW_OWNER (FIELD_PTR, UBOUNDS, LBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR) -#include "field_statistics.h" +USE FIELD_STATISTICS_MODULE CLASS(${ft.name}$), POINTER :: FIELD_PTR TYPE(${ft.name}$_OWNER), POINTER :: FIELD_OWNER @@ -72,13 +72,13 @@ CALL FIELD_OWNER%INIT (LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=PERSISTENT, FIELD_PTR => FIELD_OWNER -field_statistics_new () +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) -#include "field_statistics.h" +USE FIELD_STATISTICS_MODULE CLASS(${ft.name}$), POINTER :: FIELD_PTR ${ft.type}$, TARGET, INTENT (IN) :: DATA (${ft.shape}$) @@ -94,14 +94,14 @@ CALL FIELD_WRAPPER%INIT (DATA, LBOUNDS=LBOUNDS, PERSISTENT=PERSISTENT, MAP_DEVPT FIELD_PTR => FIELD_WRAPPER -field_statistics_new () +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) -#include "field_statistics.h" +USE FIELD_STATISTICS_MODULE #:set fieldTypeList1 = fieldType.getFieldTypeList (ranks=[ft.rank-1], kinds=[ft.kind]) #:set ft1 = fieldTypeList1[0] @@ -129,13 +129,13 @@ DO JFLD = 1, SIZE (CHILDREN) FIELD_GANG%CHILDREN (JFLD)%PTR%PARENT => FIELD_PTR ENDDO -field_statistics_new () +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) -#include "field_statistics.h" +USE FIELD_STATISTICS_MODULE #:set fieldTypeList1 = fieldType.getFieldTypeList (ranks=[ft.rank-1], kinds=[ft.kind]) #:set ft1 = fieldTypeList1[0] @@ -164,7 +164,7 @@ DO JFLD = 1, SIZE (CHILDREN) FIELD_GANG%CHILDREN (JFLD)%PTR%PARENT => FIELD_PTR ENDDO -field_statistics_new () +IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_NEW () END SUBROUTINE @@ -172,11 +172,11 @@ END SUBROUTINE SUBROUTINE ${ft.name}$_DELETE (FIELD_PTR) -#include "field_statistics.h" +USE FIELD_STATISTICS_MODULE CLASS(${ft.name}$), POINTER :: FIELD_PTR -field_statistics_delete () +IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DELETE () CALL FIELD_PTR%FINAL () DEALLOCATE (FIELD_PTR) diff --git a/field_RANKSUFF_gang_module.fypp b/field_RANKSUFF_gang_module.fypp index 7084fe6..f413b88 100644 --- a/field_RANKSUFF_gang_module.fypp +++ b/field_RANKSUFF_gang_module.fypp @@ -116,7 +116,7 @@ CONTAINS SUBROUTINE ${ftn}$_GANG_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR, SYNC_ON_FINAL) -#include "field_statistics.h" + USE FIELD_STATISTICS_MODULE CLASS(${ftn}$_GANG_WRAPPER) :: SELF ${ft.type}$, TARGET, INTENT(IN) :: DATA(${ft.shape}$) @@ -147,7 +147,7 @@ CONTAINS DO JFLD = 1, NFLD ALLOCATE (YLFW) - field_statistics_new () + 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 @@ -158,7 +158,7 @@ CONTAINS SUBROUTINE ${ftn}$_GANG_OWNER_INIT(SELF, LBOUNDS, UBOUNDS, PERSISTENT, DELAYED, INIT_VALUE, PINNED, MAP_DEVPTR) -#include "field_statistics.h" + USE FIELD_STATISTICS_MODULE CLASS(${ftn}$_GANG_OWNER) :: SELF INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: LBOUNDS(${ft.rank}$) @@ -192,7 +192,7 @@ CONTAINS DO JFLD = 1, NFLD ALLOCATE (YLFW) - field_statistics_new () + 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 @@ -204,7 +204,7 @@ CONTAINS #:for type in ['WRAPPER', 'OWNER'] SUBROUTINE ${ftn}$_GANG_${type}$_FINAL(SELF) -#include "field_statistics.h" + USE FIELD_STATISTICS_MODULE CLASS(${ftn}$_GANG_${type}$) :: SELF ${ft.type}$, POINTER :: PTR(${ft.shape}$) @@ -213,7 +213,7 @@ CONTAINS DO JFLD = 1, SIZE (SELF%CHILDREN) - field_statistics_delete () + IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DELETE () YLF => SELF%CHILDREN(JFLD)%PTR NULLIFY (YLF%DEVPTR) diff --git a/field_statistics.h b/field_statistics.h deleted file mode 100644 index 4c89942..0000000 --- a/field_statistics.h +++ /dev/null @@ -1,13 +0,0 @@ - -USE FIELD_STATISTICS_MODULE, ONLY : FS => FIELD_STATISTICS, FE => FIELD_STATISTICS_ENABLE - -#define field_statistics_new() IF(FE)THEN;FS%NFIELDS_CUR=FS%NFIELDS_CUR+1;FS%NFIELDS_MAX=MAX(FS%NFIELDS_CUR,FS%NFIELDS_MAX);ENDIF -#define field_statistics_delete() IF(FE)THEN;FS%NFIELDS_CUR=FS%NFIELDS_CUR-1;ENDIF - -#define field_statistics_host_allocate(p) IF(FE)THEN;FS%MEMORY_HOST_CUR=FS%MEMORY_HOST_CUR+SIZE(p)*KIND(p);FS%MEMORY_HOST_MAX=MAX(FS%MEMORY_HOST_CUR,FS%MEMORY_HOST_MAX);ENDIF -#define field_statistics_host_deallocate(p) IF(FE)THEN;FS%MEMORY_HOST_CUR=FS%MEMORY_HOST_CUR-SIZE(p)*KIND(p);ENDIF - -#define field_statistics_device_allocate(p) IF(FE)THEN;FS%MEMORY_DEVICE_CUR=FS%MEMORY_DEVICE_CUR+SIZE(p)*KIND(p);FS%MEMORY_DEVICE_MAX=MAX(FS%MEMORY_DEVICE_CUR,FS%MEMORY_DEVICE_MAX);ENDIF -#define field_statistics_device_deallocate(p) IF(FE)THEN;FS%MEMORY_DEVICE_CUR=FS%MEMORY_DEVICE_CUR-SIZE(p)*KIND(p);ENDIF - - diff --git a/field_statistics_module.F90 b/field_statistics_module.F90 index e9952df..2c76b3d 100644 --- a/field_statistics_module.F90 +++ b/field_statistics_module.F90 @@ -1,6 +1,6 @@ MODULE FIELD_STATISTICS_MODULE -USE PARKIND1, ONLY : JPIB +USE PARKIND1, ONLY : JPIB, JPIM IMPLICIT NONE @@ -15,11 +15,56 @@ MODULE FIELD_STATISTICS_MODULE INTEGER (KIND=JPIB) :: NFIELDS_MAX = 0 END TYPE -PRIVATE - LOGICAL, SAVE :: FIELD_STATISTICS_ENABLE = .FALSE. TYPE (FIELD_STATISTICS_TYPE), SAVE :: FIELD_STATISTICS -PUBLIC :: FIELD_STATISTICS, FIELD_STATISTICS_ENABLE +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=JPIM), 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=JPIM), INTENT (IN) :: KSIZE + +FIELD_STATISTICS%MEMORY_HOST_CUR = FIELD_STATISTICS%MEMORY_HOST_CUR-KSIZE + +END SUBROUTINE + +SUBROUTINE FIELD_STATISTICS_DEVICE_ALLOCATE (KSIZE) + +INTEGER (KIND=JPIM), 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=JPIM), INTENT (IN) :: KSIZE + +FIELD_STATISTICS%MEMORY_DEVICE_CUR = FIELD_STATISTICS%MEMORY_DEVICE_CUR-KSIZE + +END SUBROUTINE END MODULE diff --git a/host_alloc_module.fypp b/host_alloc_module.fypp index d9e6e8d..b6e5385 100644 --- a/host_alloc_module.fypp +++ b/host_alloc_module.fypp @@ -53,7 +53,7 @@ CONTAINS #:for ft in fieldTypeList SUBROUTINE ${ft.name}$_HOST_ALLOC (HST, LBOUNDS, UBOUNDS, PINNED) -#include "field_statistics.h" + USE FIELD_STATISTICS_MODULE USE FIELD_ABORT_MODULE @@ -92,13 +92,13 @@ 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 - field_statistics_host_allocate (HST) + IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_HOST_ALLOCATE (SIZE (HST) * KIND (HST)) END SUBROUTINE ${ft.name}$_HOST_ALLOC SUBROUTINE ${ft.name}$_HOST_DEALLOC(HST, PINNED) -#include "field_statistics.h" + USE FIELD_STATISTICS_MODULE USE FIELD_ABORT_MODULE @@ -108,7 +108,7 @@ SUBROUTINE ${ft.name}$_HOST_DEALLOC(HST, PINNED) TYPE(C_PTR) :: DATA INTEGER :: ISTAT - field_statistics_host_deallocate (HST) + IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_HOST_DEALLOCATE (SIZE (HST) * KIND (HST)) IF(SIZE(HST) > 0)THEN DATA = C_LOC (HST (${ ', '.join (map (lambda i: 'LBOUND (HST, ' + str (i) + ')', range (1, ft.rank+1))) }$)) diff --git a/tests/test_statistics.F90 b/tests/test_statistics.F90 index 41080cd..c7835a3 100644 --- a/tests/test_statistics.F90 +++ b/tests/test_statistics.F90 @@ -23,40 +23,48 @@ PROGRAM TEST_STATISTICS INTEGER (KIND=JPIM) :: IDATA0 (5,3,2,9) INTEGER (KIND=JPIM), POINTER :: IDATA (:,:,:,:) -#define assert(cond) IF (.NOT.(cond)) CALL FIELD_ABORT ("'"//#cond//"' IS FALSE") - FIELD_STATISTICS_ENABLE = .TRUE. CALL FIELD_NEW (YLF1, UBOUNDS=UBOUNDS, PERSISTENT=.TRUE.) -assert (FIELD_STATISTICS%NFIELDS_CUR==1) +CALL ASSERT (FIELD_STATISTICS%NFIELDS_CUR==1) CALL FIELD_NEW (YLF2, DATA=IDATA0, PERSISTENT=.TRUE.) -assert (FIELD_STATISTICS%NFIELDS_CUR==2) +CALL ASSERT (FIELD_STATISTICS%NFIELDS_CUR==2) -assert (FIELD_STATISTICS%MEMORY_DEVICE_CUR==0) +CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==0) IDATA => GET_DEVICE_DATA_RDONLY (YLF1) -assert (FIELD_STATISTICS%MEMORY_DEVICE_CUR==KIND(IDATA)*SIZE(IDATA)) +CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==KIND(IDATA)*SIZE(IDATA)) IDATA => GET_DEVICE_DATA_RDONLY (YLF2) -assert (FIELD_STATISTICS%MEMORY_DEVICE_CUR==JPIM*PRODUCT(UBOUNDS)+JPIM*SIZE(IDATA0)) +CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==JPIM*PRODUCT(UBOUNDS)+JPIM*SIZE(IDATA0)) CALL FIELD_DELETE (YLF1) -assert (FIELD_STATISTICS%NFIELDS_CUR==1) +CALL ASSERT (FIELD_STATISTICS%NFIELDS_CUR==1) CALL FIELD_DELETE (YLF2) -assert (FIELD_STATISTICS%NFIELDS_CUR==0) +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(UBOUNDS)*JPIM+SIZE(IDATA0)*JPIM) + +CONTAINS + +SUBROUTINE ASSERT (LDCOND) -assert (FIELD_STATISTICS%NFIELDS_MAX==2) +LOGICAL :: LDCOND -assert (FIELD_STATISTICS%MEMORY_DEVICE_CUR==0) +IF (.NOT. LDCOND) CALL FIELD_ABORT ('UNEXPECTED VALUE') -assert (FIELD_STATISTICS%MEMORY_DEVICE_MAX==PRODUCT(UBOUNDS)*JPIM+SIZE(IDATA0)*JPIM) +END SUBROUTINE END PROGRAM From 1d4e83c64dd0e01d7d5accde9caa8c52fa450fde Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Mon, 1 Apr 2024 12:37:04 +0000 Subject: [PATCH 4/5] Use JPIB integers for recording sizes --- dev_alloc_module.fypp | 8 ++++---- field_statistics_module.F90 | 8 ++++---- host_alloc_module.fypp | 4 ++-- tests/test_statistics.F90 | 8 ++++---- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/dev_alloc_module.fypp b/dev_alloc_module.fypp index bb7d79d..ddd86e1 100644 --- a/dev_alloc_module.fypp +++ b/dev_alloc_module.fypp @@ -136,7 +136,7 @@ IF(MAP_DEVPTR)THEN !$acc enter data create (DEV) ENDIF -IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_ALLOCATE (SIZE (DEV) * KIND (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_DIM @@ -153,7 +153,7 @@ INTEGER :: ISTAT IF (ASSOCIATED (DEV)) THEN - IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_DEALLOCATE (SIZE (DEV) * KIND (DEV)) + 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))) }$)) @@ -189,7 +189,7 @@ ALLOCATE (DEV, MOLD=HST) !$acc enter data create (DEV) -IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_ALLOCATE (SIZE (DEV) * KIND (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 @@ -200,7 +200,7 @@ LOGICAL, INTENT(IN) :: MAP_DEVPTR IF (ASSOCIATED (DEV)) THEN - IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_DEVICE_DEALLOCATE (SIZE (DEV) * KIND (DEV)) + 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) diff --git a/field_statistics_module.F90 b/field_statistics_module.F90 index 2c76b3d..08a56ef 100644 --- a/field_statistics_module.F90 +++ b/field_statistics_module.F90 @@ -35,7 +35,7 @@ SUBROUTINE FIELD_STATISTICS_DELETE () SUBROUTINE FIELD_STATISTICS_HOST_ALLOCATE (KSIZE) -INTEGER (KIND=JPIM), INTENT (IN) :: 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) @@ -44,7 +44,7 @@ SUBROUTINE FIELD_STATISTICS_HOST_ALLOCATE (KSIZE) SUBROUTINE FIELD_STATISTICS_HOST_DEALLOCATE (KSIZE) -INTEGER (KIND=JPIM), INTENT (IN) :: KSIZE +INTEGER (KIND=JPIB), INTENT (IN) :: KSIZE FIELD_STATISTICS%MEMORY_HOST_CUR = FIELD_STATISTICS%MEMORY_HOST_CUR-KSIZE @@ -52,7 +52,7 @@ SUBROUTINE FIELD_STATISTICS_HOST_DEALLOCATE (KSIZE) SUBROUTINE FIELD_STATISTICS_DEVICE_ALLOCATE (KSIZE) -INTEGER (KIND=JPIM), INTENT (IN) :: 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) @@ -61,7 +61,7 @@ SUBROUTINE FIELD_STATISTICS_DEVICE_ALLOCATE (KSIZE) SUBROUTINE FIELD_STATISTICS_DEVICE_DEALLOCATE (KSIZE) -INTEGER (KIND=JPIM), INTENT (IN) :: KSIZE +INTEGER (KIND=JPIB), INTENT (IN) :: KSIZE FIELD_STATISTICS%MEMORY_DEVICE_CUR = FIELD_STATISTICS%MEMORY_DEVICE_CUR-KSIZE diff --git a/host_alloc_module.fypp b/host_alloc_module.fypp index b6e5385..b5364f9 100644 --- a/host_alloc_module.fypp +++ b/host_alloc_module.fypp @@ -92,7 +92,7 @@ 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 (HST)) + IF (FIELD_STATISTICS_ENABLE) CALL FIELD_STATISTICS_HOST_ALLOCATE (SIZE (HST, KIND=JPIB) * INT (KIND (HST), KIND=JPIB)) END SUBROUTINE ${ft.name}$_HOST_ALLOC @@ -108,7 +108,7 @@ 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 (HST)) + 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))) }$)) diff --git a/tests/test_statistics.F90 b/tests/test_statistics.F90 index c7835a3..20e6ea3 100644 --- a/tests/test_statistics.F90 +++ b/tests/test_statistics.F90 @@ -19,7 +19,7 @@ PROGRAM TEST_STATISTICS IMPLICIT NONE CLASS(FIELD_4IM), POINTER :: YLF1 => NULL(), YLF2 => NULL () -INTEGER (KIND=JPIM) :: UBOUNDS (4) = [4,4,2,7] +INTEGER (KIND=JPIM) :: UBOUNDS (4) = [2,1000,1000,1000] INTEGER (KIND=JPIM) :: IDATA0 (5,3,2,9) INTEGER (KIND=JPIM), POINTER :: IDATA (:,:,:,:) @@ -37,11 +37,11 @@ PROGRAM TEST_STATISTICS IDATA => GET_DEVICE_DATA_RDONLY (YLF1) -CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==KIND(IDATA)*SIZE(IDATA)) +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==JPIM*PRODUCT(UBOUNDS)+JPIM*SIZE(IDATA0)) +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) @@ -55,7 +55,7 @@ PROGRAM TEST_STATISTICS CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_CUR==0) -CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_MAX==PRODUCT(UBOUNDS)*JPIM+SIZE(IDATA0)*JPIM) +CALL ASSERT (FIELD_STATISTICS%MEMORY_DEVICE_MAX==PRODUCT(INT(UBOUNDS,JPIB))*INT(JPIM,JPIB)+SIZE(IDATA0,KIND=JPIB)*INT(JPIM,JPIB)) CONTAINS From 9349d8a302e4461f53e7f0857137b97f396496b4 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Mon, 1 Apr 2024 14:54:54 +0000 Subject: [PATCH 5/5] Smaller arrays --- tests/test_statistics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/test_statistics.F90 b/tests/test_statistics.F90 index 20e6ea3..7428b0b 100644 --- a/tests/test_statistics.F90 +++ b/tests/test_statistics.F90 @@ -19,7 +19,7 @@ PROGRAM TEST_STATISTICS IMPLICIT NONE CLASS(FIELD_4IM), POINTER :: YLF1 => NULL(), YLF2 => NULL () -INTEGER (KIND=JPIM) :: UBOUNDS (4) = [2,1000,1000,1000] +INTEGER (KIND=JPIM) :: UBOUNDS (4) = [2,10,10,10] INTEGER (KIND=JPIM) :: IDATA0 (5,3,2,9) INTEGER (KIND=JPIM), POINTER :: IDATA (:,:,:,:)