Do not use cpp macros (not supported by gfortran)

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)

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,19 +164,19 @@ 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
 
 #:endif
 
 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)

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)

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

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))) }$))

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