diff --git a/CMakeLists.txt b/CMakeLists.txt index 0b7538c..632c0f0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -93,7 +93,7 @@ if( NOT fiat_FOUND ) list(APPEND srcs ${ABOR1_PATH} ${OML_PATH} ${PARKIND1_PATH}) endif() -list(APPEND srcs field_async_module.F90 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) +list(APPEND srcs field_async_module.F90 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 field_backtrace.c) ## check for CUDA include(CheckLanguage) @@ -108,6 +108,8 @@ ecbuild_add_option( FEATURE BUDDY_MALLOC DEFAULT ON ) +check_symbol_exists(backtrace execinfo.h HAVE_BACKTRACE) + ## fypp preprocessor flags if(HAVE_BUDDY_MALLOC) list( APPEND fypp_defines "-DUSE_BUDDY_MALLOC") @@ -174,6 +176,10 @@ foreach(prec ${precisions}) INTERFACE $ ) + if( HAVE_BACKTRACE ) + target_compile_definitions( ${LIBNAME}_${prec} PRIVATE HAVE_BACKTRACE ) + endif() + if( prec MATCHES sp ) target_compile_definitions( ${LIBNAME}_${prec} PRIVATE PARKIND1_SINGLE ) endif() diff --git a/field_RANKSUFF_access_module.fypp b/field_RANKSUFF_access_module.fypp index 1dfa873..e0d6acf 100644 --- a/field_RANKSUFF_access_module.fypp +++ b/field_RANKSUFF_access_module.fypp @@ -55,12 +55,26 @@ CONTAINS #:for ft in fieldTypeList SUBROUTINE SGET_${what}$_DATA_${mode}$_${ft.name}$ (PTR, FIELD_PTR) + USE FIELD_DEFAULTS_MODULE + CLASS (${ft.name}$), POINTER, OPTIONAL :: FIELD_PTR ${ft.type}$, POINTER :: PTR(${ft.shape}$) + INTEGER*8 :: ICRC + CHARACTER*1024 :: CLBT + CHARACTER*10 :: CLF + INTEGER :: ILEN, IP1, IP2 + + + ICRC = 0 IF (PRESENT (FIELD_PTR)) THEN IF (ASSOCIATED (FIELD_PTR)) THEN CALL FIELD_PTR%GET_${what}$_DATA_${mode}$ (PTR) + + IF (GET_DEBUG_PRINT_CRC) THEN + ICRC = FIELD_PTR%CRC64 () + ENDIF + ELSE PTR => DUMMY_${ft.name}$ ENDIF @@ -68,6 +82,32 @@ CONTAINS PTR => DUMMY_${ft.name}$ ENDIF + + IF (GET_DEBUG_PRINT_CRC) THEN + WRITE (0, '(Z16.16," ")', ADVANCE='NO') ICRC + ENDIF + + IF (GET_DEBUG_PRINT_LOCATION .OR. GET_DEBUG_PRINT_CRC) THEN + CLF = "${ft.name}$" + WRITE (0, '(A10)', ADVANCE='NO') CLF + CLF = "${mode}$" + WRITE (0, '(A10)', ADVANCE='NO') CLF + CLF = "${what}$" + WRITE (0, '(A10)', ADVANCE='NO') CLF + ENDIF + + IF (GET_DEBUG_PRINT_LOCATION) THEN + ILEN = LEN (CLBT) + IP1 = 2 + IP2 = 2 + GET_DEBUG_PRINT_LOCATION_DEPTH + CALL FIELD_BACKTRACE (CLBT, IP1, IP2, ILEN) + WRITE (0, '(A)', ADVANCE='NO') CLBT (1:ILEN) + ENDIF + + IF (GET_DEBUG_PRINT_LOCATION .OR. GET_DEBUG_PRINT_CRC) THEN + WRITE (0, *) + ENDIF + END SUBROUTINE SGET_${what}$_DATA_${mode}$_${ft.name}$ FUNCTION GET_${what}$_DATA_${mode}$_${ft.name}$ (FIELD_PTR) RESULT (PTR) diff --git a/field_RANKSUFF_module.fypp b/field_RANKSUFF_module.fypp index d2d9169..595c54d 100644 --- a/field_RANKSUFF_module.fypp +++ b/field_RANKSUFF_module.fypp @@ -69,6 +69,7 @@ CONTAINS PROCEDURE, PRIVATE :: ${ftn}$_GET_DEVICE_DATA PROCEDURE, PRIVATE :: COPY_DATA => ${ftn}$_COPY_DATA PROCEDURE :: CREATE_DEVICE_DATA => ${ftn}$_CREATE_DEVICE_DATA + PROCEDURE :: CRC64 => ${ftn}$_CRC64 #ifdef __PGI PROCEDURE :: SET_STATUS => ${ftn}$_SET_STATUS #endif @@ -521,6 +522,31 @@ CONTAINS END SUBROUTINE ${ftn}$_GET_DEVICE_DATA + INTEGER*8 FUNCTION ${ftn}$_CRC64 (SELF) RESULT (ICRC) + CLASS(${ftn}$) :: SELF + ${ft.type}$, POINTER :: PTR(${ft.shape}$) + ${ft.type}$, ALLOCATABLE :: ZZ(${ft.shape}$) + INTEGER*8 :: ILEN + EXTERNAL :: CRC64 + + ICRC = 0 + + IF (IAND (SELF%GET_STATUS (), NHSTFRESH) /= 0) THEN + CALL SELF%GET_HOST_DATA_RDONLY (PTR) + ILEN = SIZE (PTR) * KIND (PTR) + CALL CRC64 (PTR, ILEN, ICRC) + ELSEIF (IAND (SELF%GET_STATUS (), NDEVFRESH) /= 0) THEN + CALL SELF%GET_DEVICE_DATA_RDONLY (PTR) + ALLOCATE (ZZ, MOLD=PTR) +!$acc kernels present (PTR) copyout (ZZ) + ZZ = PTR +!$acc end kernels + ILEN = SIZE (ZZ) * KIND (ZZ) + CALL CRC64 (ZZ, ILEN, ICRC) + ENDIF + + END FUNCTION + SUBROUTINE ${ftn}$_OWNER_GET_DEVICE_DATA (SELF, MODE, PTR, QUEUE) CLASS(${ftn}$_OWNER) :: SELF INTEGER (KIND=JPIM), INTENT(IN) :: MODE diff --git a/field_RANKSUFF_util_module.fypp b/field_RANKSUFF_util_module.fypp index 02d8145..e4a9bfe 100644 --- a/field_RANKSUFF_util_module.fypp +++ b/field_RANKSUFF_util_module.fypp @@ -38,19 +38,12 @@ CONTAINS #:for ft in fieldTypeList INTEGER*8 FUNCTION CRC64_${ft.name}$ (YD) CLASS (${ft.name}$), POINTER :: YD - -INTEGER*8 :: ICRC, ILEN -${ft.type}$, POINTER :: PTR(${ft.shape}$) -EXTERNAL :: CRC64 +INTEGER*8 :: ICRC ICRC = 0 IF (ASSOCIATED (YD)) THEN - - PTR => GET_HOST_DATA_RDONLY (YD) - ILEN = SIZE (PTR) - CALL CRC64 (PTR, ILEN, ICRC) - + ICRC = YD%CRC64 () ENDIF CRC64_${ft.name}$ = ICRC diff --git a/field_backtrace.c b/field_backtrace.c new file mode 100644 index 0000000..cbd9356 --- /dev/null +++ b/field_backtrace.c @@ -0,0 +1,40 @@ +#include + +#ifdef HAVE_BACKTRACE + +#include +#include + +void field_backtrace_ (char * str, int * p1, int * p2, int * plen) +{ + void * addr[*p2]; + int size; + int i; + char * pstr = str; + + memset (str, ' ', *plen); + + size = backtrace (addr, *p2); + + for (i = *p1; i < size; i++) + { + sprintf (pstr, " 0x%16.16llx", addr[i]); + pstr += 3 + 16; + } + + *plen = pstr - str; + +} + + +#else + +void field_backtrace_ (char * str, int * p1, int * p2, int * plen) +{ + memset (str, ' ', *plen); + *plen = 0; +} + +#endif + + diff --git a/field_basic_module.F90 b/field_basic_module.F90 index 97de3cf..d8615a6 100644 --- a/field_basic_module.F90 +++ b/field_basic_module.F90 @@ -44,6 +44,7 @@ MODULE FIELD_BASIC_MODULE PROCEDURE (FIELD_BASIC_SYNC), DEFERRED :: SYNC_DEVICE_RDONLY PROCEDURE (FIELD_BASIC_DELETE_DEVICE_DATA), DEFERRED :: DELETE_DEVICE_DATA PROCEDURE (FIELD_BASIC_CREATE_DEVICE_DATA), DEFERRED :: CREATE_DEVICE_DATA + PROCEDURE (FIELD_BASIC_CRC64), DEFERRED :: CRC64 PROCEDURE :: SET_CHILDREN_DEVPTR => FIELD_BASIC_SET_CHILDREN_DEVPTR PROCEDURE :: SET_DEVICE_DIRTY => FIELD_BASIC_SET_DEVICE_DIRTY PROCEDURE :: SET_STATUS => FIELD_BASIC_SET_STATUS @@ -66,6 +67,10 @@ SUBROUTINE FIELD_BASIC_CREATE_DEVICE_DATA (SELF) IMPORT FIELD_BASIC CLASS(FIELD_BASIC) :: SELF END SUBROUTINE + INTEGER*8 FUNCTION FIELD_BASIC_CRC64 (SELF) + IMPORT FIELD_BASIC + CLASS(FIELD_BASIC) :: SELF + END FUNCTION END INTERFACE PUBLIC :: FIELD_BASIC_SYNC diff --git a/field_defaults_module.F90 b/field_defaults_module.F90 index 292044e..a1a3480 100644 --- a/field_defaults_module.F90 +++ b/field_defaults_module.F90 @@ -6,7 +6,19 @@ MODULE FIELD_DEFAULTS_MODULE REAL(KIND=JPRD) :: INIT_DEBUG_VALUE_JPRD = 0.0_JPRD INTEGER(KIND=JPIM) :: INIT_DEBUG_VALUE_JPIM = 0_JPIM LOGICAL(KIND=JPLM) :: INIT_DEBUG_VALUE_JPLM = .FALSE. + LOGICAL :: GET_DEBUG_PRINT_CRC = .FALSE. + LOGICAL :: GET_DEBUG_PRINT_LOCATION = .FALSE. LOGICAL :: INIT_PINNED_VALUE = .FALSE. LOGICAL :: INIT_SYNC_ON_FINAL = .TRUE. LOGICAL :: INIT_MAP_DEVPTR = .TRUE. + INTEGER :: GET_DEBUG_PRINT_LOCATION_DEPTH = 3 + + 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 + END MODULE FIELD_DEFAULTS_MODULE diff --git a/tests/test_crc64.F90 b/tests/test_crc64.F90 index 9bbe13e..41c4641 100644 --- a/tests/test_crc64.F90 +++ b/tests/test_crc64.F90 @@ -24,9 +24,8 @@ PROGRAM TEST_CRC64 REAL(KIND=JPRB), POINTER :: VIEW(:) => NULL() INTEGER*8 :: ICRC64_PI, ICRC64_E, ICRC - DATA ICRC64_PI / Z'33E2D12C420E6E86' / - DATA ICRC64_E / Z'817AF6E200A0FC70' / - + DATA ICRC64_PI / Z'158D5E22445EA9D8' / + DATA ICRC64_E / Z'3A21FCC09C73ADA1' / ALLOCATE(D(NPROMA, NBLOCKS)) diff --git a/tests/test_gang.F90 b/tests/test_gang.F90 index 6de37ed..8dacc20 100644 --- a/tests/test_gang.F90 +++ b/tests/test_gang.F90 @@ -10,6 +10,7 @@ PROGRAM TEST_GANG USE FIELD_MODULE +USE FIELD_DEFAULTS_MODULE USE FIELD_FACTORY_MODULE USE FIELD_ACCESS_MODULE USE FIELD_ABORT_MODULE @@ -29,12 +30,17 @@ PROGRAM TEST_GANG INTEGER (KIND=JPIM) :: JDIM INTEGER (KIND=JPIM) :: ISTEP LOGICAL, PARAMETER :: LLVERBOSE = .TRUE. +CHARACTER*8 :: CLENV INTEGER :: IERROR = 0 REAL (KIND=JPRD) :: ZCOEF (NDIM) !$acc declare create (ZCOEF) + +CALL GETENV ('GET_DEBUG_PRINT_CRC', CLENV); GET_DEBUG_PRINT_CRC = CLENV /= '0' .AND. CLENV /= '' +CALL GETENV ('GET_DEBUG_PRINT_LOCATION', CLENV); GET_DEBUG_PRINT_LOCATION = CLENV /= '0' .AND. CLENV /= '' + ALLOCATE (ZDATA4 (ILB (1):IUB (1), ILB (2):IUB (2), ILB (3):IUB (3), ILB (4):IUB (4))) DO JDIM = 1, NDIM