Add an option to disable wrapper field synchronization on object dest…

…ruction

field_RANKSUFF_factory_module.fypp

@@ -72,25 +72,26 @@ 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}$)
 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)))
 

field_RANKSUFF_gang_module.fypp

@@ -114,20 +114,21 @@ 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
     INTEGER (KIND=JPIM) :: LLBOUNDS (${ft.rank}$)
     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

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,15 +135,18 @@ 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
     ${ft.type}$, TARGET, INTENT(IN) :: DATA(${ft.shape}$)
     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
 

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

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

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