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