diff --git a/field_RANKSUFF_factory_module.fypp b/field_RANKSUFF_factory_module.fypp index 76d8f90..dfc492c 100644 --- a/field_RANKSUFF_factory_module.fypp +++ b/field_RANKSUFF_factory_module.fypp @@ -72,7 +72,7 @@ FIELD_PTR => FIELD_OWNER END SUBROUTINE -SUBROUTINE ${ft.name}$_NEW_WRAPPER (FIELD_PTR, LBOUNDS, PERSISTENT, DATA, MAP_DEVPTR) +SUBROUTINE ${ft.name}$_NEW_WRAPPER (FIELD_PTR, LBOUNDS, PERSISTENT, DATA, MAP_DEVPTR, SYNC_ON_FINAL) CLASS(${ft.name}$), POINTER :: FIELD_PTR ${ft.type}$, TARGET, INTENT (IN) :: DATA (${ft.shape}$) @@ -80,17 +80,18 @@ TYPE(${ft.name}$_WRAPPER), POINTER :: FIELD_WRAPPER INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$) LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT LOGICAL, OPTIONAL, INTENT(IN) :: MAP_DEVPTR +LOGICAL, OPTIONAL, INTENT(IN) :: SYNC_ON_FINAL ALLOCATE (FIELD_WRAPPER) -CALL FIELD_WRAPPER%INIT (DATA, LBOUNDS=LBOUNDS, PERSISTENT=PERSISTENT, MAP_DEVPTR=MAP_DEVPTR) +CALL FIELD_WRAPPER%INIT (DATA, LBOUNDS=LBOUNDS, PERSISTENT=PERSISTENT, MAP_DEVPTR=MAP_DEVPTR, SYNC_ON_FINAL=SYNC_ON_FINAL) FIELD_PTR => FIELD_WRAPPER END SUBROUTINE #:if ft.ganged -SUBROUTINE ${ft.name}$_NEW_GANG_WRAPPER (FIELD_PTR, CHILDREN, LBOUNDS, PERSISTENT, DATA) +SUBROUTINE ${ft.name}$_NEW_GANG_WRAPPER (FIELD_PTR, CHILDREN, LBOUNDS, PERSISTENT, DATA, SYNC_ON_FINAL) #:set fieldTypeList1 = fieldType.getFieldTypeList (ranks=[ft.rank-1], kinds=[ft.kind]) #:set ft1 = fieldTypeList1[0] @@ -100,13 +101,14 @@ TYPE(${ft1.name}$_PTR), ALLOCATABLE :: CHILDREN (:) ${ft.type}$, TARGET, INTENT (IN) :: DATA (${ft.shape}$) INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$) LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT +LOGICAL, OPTIONAL, INTENT(IN) :: SYNC_ON_FINAL TYPE(${ft.name}$_GANG_WRAPPER), POINTER :: FIELD_GANG INTEGER (KIND=JPIM) :: JFLD ALLOCATE (FIELD_GANG) -CALL FIELD_GANG%INIT (DATA, LBOUNDS=LBOUNDS, PERSISTENT=PERSISTENT) +CALL FIELD_GANG%INIT (DATA, LBOUNDS=LBOUNDS, PERSISTENT=PERSISTENT, SYNC_ON_FINAL=SYNC_ON_FINAL) ALLOCATE (CHILDREN (SIZE (FIELD_GANG%CHILDREN))) diff --git a/field_RANKSUFF_gang_module.fypp b/field_RANKSUFF_gang_module.fypp index 61e57b6..9571f1e 100644 --- a/field_RANKSUFF_gang_module.fypp +++ b/field_RANKSUFF_gang_module.fypp @@ -114,12 +114,13 @@ CONTAINS #:endfor - SUBROUTINE ${ftn}$_GANG_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR) + SUBROUTINE ${ftn}$_GANG_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR, SYNC_ON_FINAL) CLASS(${ftn}$_GANG_WRAPPER) :: SELF ${ft.type}$, TARGET, INTENT(IN) :: DATA(${ft.shape}$) LOGICAL, INTENT(IN), OPTIONAL :: PERSISTENT INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: LBOUNDS(${ft.rank}$) LOGICAL, INTENT(IN), OPTIONAL :: MAP_DEVPTR + LOGICAL, INTENT(IN), OPTIONAL :: SYNC_ON_FINAL LOGICAL :: LLPERSISTENT INTEGER (KIND=JPIM) :: IFLR, JFLD, NFLD @@ -127,7 +128,7 @@ CONTAINS CLASS (${ftn1}$_WRAPPER_HELPER), POINTER :: YLFW - CALL SELF%${ftn}$_WRAPPER%INIT (DATA=DATA, PERSISTENT=PERSISTENT, LBOUNDS=LBOUNDS, MAP_DEVPTR=MAP_DEVPTR) + CALL SELF%${ftn}$_WRAPPER%INIT (DATA=DATA, PERSISTENT=PERSISTENT, LBOUNDS=LBOUNDS, MAP_DEVPTR=MAP_DEVPTR, SYNC_ON_FINAL=SYNC_ON_FINAL) LLBOUNDS = 1 IF (PRESENT (LBOUNDS)) LLBOUNDS = LBOUNDS @@ -142,7 +143,7 @@ CONTAINS DO JFLD = 1, NFLD ALLOCATE (YLFW) - CALL YLFW%INIT (DATA=DATA(${ar}$, JFLD, :), PERSISTENT=PERSISTENT, LBOUNDS=LLBOUNDS(1:IFLR), MAP_DEVPTR=MAP_DEVPTR) + 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 ()) ENDDO @@ -181,7 +182,7 @@ CONTAINS DO JFLD = 1, NFLD ALLOCATE (YLFW) - CALL YLFW%INIT (DATA=SELF%PTR (${ar}$, JFLD, :), PERSISTENT=PERSISTENT, LBOUNDS=LLBOUNDS(1:IFLR)) + 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 ()) ENDDO diff --git a/field_RANKSUFF_module.fypp b/field_RANKSUFF_module.fypp index 997cef5..08a67b7 100644 --- a/field_RANKSUFF_module.fypp +++ b/field_RANKSUFF_module.fypp @@ -88,6 +88,7 @@ END INTERFACE PUBLIC :: ${ftn}$ TYPE, EXTENDS(${ftn}$) :: ${ftn}$_WRAPPER + LOGICAL :: SYNC_ON_FINAL = .TRUE. CONTAINS PROCEDURE :: INIT => ${ftn}$_WRAPPER_INIT PROCEDURE :: FINAL => ${ftn}$_WRAPPER_FINAL @@ -134,8 +135,9 @@ CONTAINS #:for ft in fieldTypeList #:set ftn = ft.name - SUBROUTINE ${ftn}$_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR) + SUBROUTINE ${ftn}$_WRAPPER_INIT(SELF, DATA, PERSISTENT, LBOUNDS, MAP_DEVPTR, SYNC_ON_FINAL) USE FIELD_ABORT_MODULE + USE FIELD_DEFAULTS_MODULE ! Create FIELD object by wrapping existing data CLASS(${ftn}$_WRAPPER) :: SELF @@ -143,6 +145,8 @@ CONTAINS LOGICAL, INTENT(IN), OPTIONAL :: PERSISTENT LOGICAL, INTENT(IN), OPTIONAL :: MAP_DEVPTR INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: LBOUNDS(${ft.rank}$) + LOGICAL, INTENT(IN), OPTIONAL :: SYNC_ON_FINAL + LOGICAL :: LLPERSISTENT #include "abor1.intfb.h" @@ -157,6 +161,7 @@ CONTAINS SELF%THREAD_BUFFER = .NOT. LLPERSISTENT CALL SELF%SET_STATUS (NHSTFRESH) + SELF%MAP_DEVPTR = INIT_MAP_DEVPTR IF(PRESENT(MAP_DEVPTR))THEN SELF%MAP_DEVPTR = MAP_DEVPTR ENDIF @@ -166,6 +171,11 @@ CONTAINS ENDIF #:endif + SELF%SYNC_ON_FINAL = INIT_SYNC_ON_FINAL + IF (PRESENT (SYNC_ON_FINAL)) THEN + SELF%SYNC_ON_FINAL = SYNC_ON_FINAL + ENDIF + IF (.NOT. LLPERSISTENT) THEN IF (OML_MAX_THREADS () /= SIZE (DATA, ${ft.rank}$)) THEN CALL FIELD_ABORT ('${ftn}$_WRAPPER_INIT: DIMENSION MISMATCH') @@ -308,7 +318,9 @@ CONTAINS ! Finalizes field and deallocates owned data CLASS(${ftn}$_WRAPPER) :: SELF ${ft.type}$, POINTER :: PTR(${ft.shape}$) - CALL SELF%GET_HOST_DATA_RDONLY(PTR) + IF (SELF%SYNC_ON_FINAL) THEN + CALL SELF%GET_HOST_DATA_RDONLY(PTR) + ENDIF CALL SELF%${ftn}$_FINAL END SUBROUTINE ${ftn}$_WRAPPER_FINAL diff --git a/field_defaults_module.F90 b/field_defaults_module.F90 index f3c97a6..292044e 100644 --- a/field_defaults_module.F90 +++ b/field_defaults_module.F90 @@ -7,4 +7,6 @@ MODULE FIELD_DEFAULTS_MODULE INTEGER(KIND=JPIM) :: INIT_DEBUG_VALUE_JPIM = 0_JPIM LOGICAL(KIND=JPLM) :: INIT_DEBUG_VALUE_JPLM = .FALSE. LOGICAL :: INIT_PINNED_VALUE = .FALSE. + LOGICAL :: INIT_SYNC_ON_FINAL = .TRUE. + LOGICAL :: INIT_MAP_DEVPTR = .TRUE. END MODULE FIELD_DEFAULTS_MODULE diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index cd5290b..1c880a5 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_wrappernosynconfinal.F90 test_field1d.F90 test_pinned.F90 async_host.F90 diff --git a/tests/test_wrappernosynconfinal.F90 b/tests/test_wrappernosynconfinal.F90 new file mode 100644 index 0000000..a789b8a --- /dev/null +++ b/tests/test_wrappernosynconfinal.F90 @@ -0,0 +1,62 @@ +! (C) Copyright 2022- ECMWF. +! (C) Copyright 2022- Meteo-France. +! +! 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_WRAPPERNOSYNCONFINAL + + USE FIELD_MODULE + USE FIELD_FACTORY_MODULE + USE FIELD_ACCESS_MODULE + USE PARKIND1 + USE FIELD_ABORT_MODULE + IMPLICIT NONE + CLASS(FIELD_2RB), POINTER :: W => NULL() + REAL(KIND=JPRB), ALLOCATABLE :: D(:,:) + REAL(KIND=JPRB), POINTER :: DD(:,:) + + ALLOCATE(D(10,4)) + + D=7 + + CALL FIELD_NEW (W, DATA=D, SYNC_ON_FINAL=.FALSE.) + + DD => GET_DEVICE_DATA_RDWR (W) + +!$acc serial present (DD) + DD = 22 +!$acc end serial + + CALL FIELD_DELETE (W) + + IF (ANY (D /= 7)) THEN + CALL FIELD_ABORT ('UNEXPECTED VALUES') + WRITE (*, *) D + ENDIF + + DEALLOCATE (D) + + ALLOCATE(D(10,4)) + + D=7 + + CALL FIELD_NEW (W, DATA=D, SYNC_ON_FINAL=.TRUE.) + + DD => GET_DEVICE_DATA_RDWR (W) + +!$acc serial present (DD) + DD = 22 +!$acc end serial + + CALL FIELD_DELETE (W) + + IF (ANY (D /= 22)) THEN + CALL FIELD_ABORT ('UNEXPECTED VALUES') + WRITE (*, *) D + ENDIF + +END PROGRAM