diff --git a/Readme.md b/Readme.md index 25ffe26c..919d5b19 100644 --- a/Readme.md +++ b/Readme.md @@ -265,6 +265,23 @@ field's data must be present on the host. It will not work if the data are on the device or if the field has not been allocated yet (when using the DELAY option). +## Cloning fields with FIELD\_CLONE\_ON_ + +The subroutines FIELD_CLONE_ON_HOST amd FIELD_CLONE_ON_DEVICE let a field be +cloned into a newly created FIELD_OWNER. The subroutines takes two arguments YL +and YR. YL is the field that will receive the copy and YR is the field to be +copied. YR is optional and can also be null, if any of those cases YL is set to +null and no cloning is done. + +``` +... + USE FIELD_CLONE_MODULE, ONLY: FIELD_CLONE_ON_HOST + CLASS(FIELD_1RB), POINTER :: MYCLONE => NULL() +... + CALL FIELD_CLONE_ON_HOST(MYCLONE, FIELD_TO_BE_CLONED) +... +``` + # Public API For field api type: @@ -292,6 +309,8 @@ Utils: ``` SUBROUTINE WAIT_FOR_ASYNC_QUEUE(QUEUE) TYPE FIELD_*D_PTR +SUBROUTINE FIELD_CLONE_ON_HOST(YL, YR) +SUBROUTINE FIELD_CLONE_ON_DEVICE(YL, YR) ``` Stats: diff --git a/src/util/CMakeLists.txt b/src/util/CMakeLists.txt index 570b0deb..0a1a3245 100644 --- a/src/util/CMakeLists.txt +++ b/src/util/CMakeLists.txt @@ -7,9 +7,9 @@ # granted to it by virtue of its status as an intergovernmental organisation # nor does it submit to any jurisdiction. -list( APPEND ranksuff_srcs _access _util _array _array_util) +list( APPEND ranksuff_srcs _access _util _array _array_util _clone) list( APPEND non_ranksuff_srcs field_access_module field_array_module - field_util_module field_array_util_module) + field_util_module field_array_util_module field_clone_module) ## expand ranksuff sources field_api_expand_fypp_ranksuff( diff --git a/src/util/field_RANKSUFF_clone_module.fypp b/src/util/field_RANKSUFF_clone_module.fypp new file mode 100644 index 00000000..796933ed --- /dev/null +++ b/src/util/field_RANKSUFF_clone_module.fypp @@ -0,0 +1,61 @@ +#! (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. + +#:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + SUFF]) +#:set ft = fieldTypeList[0] +MODULE ${ft.name}$_CLONE_MODULE + +${fieldType.useParkind1 ()}$ + +IMPLICIT NONE + +#:for TARGET in ["HOST", "DEVICE"] +INTERFACE FIELD_CLONE_ON_${TARGET}$ + MODULE PROCEDURE :: ${ft.name}$_CLONE_ON_${TARGET}$ +END INTERFACE FIELD_CLONE_ON_${TARGET}$ +PUBLIC :: FIELD_CLONE_ON_${TARGET}$ +#:endfor + +CONTAINS + +#:for TARGET in ["HOST", "DEVICE"] + +SUBROUTINE ${ft.name}$_CLONE_ON_${TARGET}$(YL, YR) + USE ${ft.name}$_MODULE + USE ${ft.name}$_FACTORY_MODULE + USE ${ft.name}$_ACCESS_MODULE + CLASS (${ft.name}$), POINTER :: YL + CLASS (${ft.name}$), OPTIONAL, POINTER :: YR + + INTEGER :: ILBOUNDS (${RANK}$), IUBOUNDS (${RANK}$) + ${ft.type}$, POINTER :: ZL (${ft.shape}$), ZR (${ft.shape}$) + + IF(.NOT. PRESENT(YR))THEN + YL => NULL() + RETURN + ENDIF + + IF(.NOT. ASSOCIATED(YR))THEN + YL => NULL() + RETURN + ENDIF + + CALL YR%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS) + CALL FIELD_NEW (YL, PERSISTENT=.TRUE., LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS) + + ZR => GET_${TARGET}$_DATA_RDONLY (YR) + ZL => GET_${TARGET}$_DATA_RDWR (YL) + +$:offload_macros.serial(present=['ZL','ZR']) if TARGET=="DEVICE" else None + ZL = ZR +$:offload_macros.end_serial() if TARGET=="DEVICE" else None +END SUBROUTINE ${ft.name}$_CLONE_ON_${TARGET}$ +#:endfor + +END MODULE ${ft.name}$_CLONE_MODULE diff --git a/src/util/field_clone_module.fypp b/src/util/field_clone_module.fypp new file mode 100644 index 00000000..01750476 --- /dev/null +++ b/src/util/field_clone_module.fypp @@ -0,0 +1,22 @@ +#! (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. + +MODULE FIELD_CLONE_MODULE + +#:set fieldTypeList = fieldType.getFieldTypeList () + +${fieldType.useParkind1 ()}$ + +#:for ft in fieldTypeList +USE ${ft.name}$_CLONE_MODULE +#:endfor + +IMPLICIT NONE + +END MODULE diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 1933ebc0..121c5bbf 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -79,9 +79,14 @@ list(APPEND TEST_FILES test_crc64.F90 test_field1d.F90 test_field_array.F90 + test_field_clone.F90 + test_field_clone_2.F90 + test_field_clone_device.F90 + test_field_clone_null.F90 + test_field_clone_optional.F90 test_field_delete_on_null.F90 - test_get_device_data_wronly.F90 test_get_device_data_non_contiguous.F90 + test_get_device_data_wronly.F90 test_host_mem_pool.F90 test_lastdim.F90 test_legacy.F90 diff --git a/tests/test_field_clone.F90 b/tests/test_field_clone.F90 new file mode 100644 index 00000000..a26735a4 --- /dev/null +++ b/tests/test_field_clone.F90 @@ -0,0 +1,36 @@ +! (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_FIELD_CLONE + !TEST IF CLONING WORKS CORRECTLY. + !IT SHOULD CREATE A FIELD_OWNER AND SO LET THE DATA BE + !ACCESSIBLE EVEN THROUGH THE ORIGIN OF THE COPY HAS BEEN DESTROYED + + USE FIELD_MODULE + USE FIELD_FACTORY_MODULE + USE FIELD_CLONE_MODULE, ONLY: FIELD_CLONE_ON_HOST + USE PARKIND1 + USE FIELD_ABORT_MODULE + IMPLICIT NONE + REAL(KIND=JPRB) :: D(10) + CLASS(FIELD_1RB), POINTER :: W => NULL() + CLASS(FIELD_1RB), POINTER :: MYCLONE => NULL() + + D = 7 + CALL FIELD_NEW(W, DATA=D) + + CALL FIELD_CLONE_ON_HOST(MYCLONE, W) + CALL FIELD_DELETE(W) + + IF (.NOT. ALL(MYCLONE%PTR == 7)) THEN + CALL FIELD_ABORT ("ERROR") + END IF + + CALL FIELD_DELETE(MYCLONE) +END PROGRAM TEST_FIELD_CLONE diff --git a/tests/test_field_clone_2.F90 b/tests/test_field_clone_2.F90 new file mode 100644 index 00000000..8bbecc4a --- /dev/null +++ b/tests/test_field_clone_2.F90 @@ -0,0 +1,49 @@ +! (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_FIELD_CLONE_2 + !TEST IF CLONING WORKS CORRECTLY. + !IF THE CLONE IS MODIFIED IT SHOULD NOT MODIFY THE SOURCE OF THE COPY + !AND RECIPROCALLY + + USE FIELD_MODULE + USE FIELD_FACTORY_MODULE + USE FIELD_CLONE_MODULE, ONLY: FIELD_CLONE_ON_HOST + USE PARKIND1 + USE FIELD_ABORT_MODULE + IMPLICIT NONE + REAL(KIND=JPRB) :: D(10) + CLASS(FIELD_1RB), POINTER :: W => NULL() + CLASS(FIELD_1RB), POINTER :: MYCLONE => NULL() + REAL(KIND=JPRB), POINTER :: PTR(:), PTR2(:) + + D = 7 + CALL FIELD_NEW(W, DATA=D) + CALL W%GET_HOST_DATA_RDWR(PTR) + + CALL FIELD_CLONE_ON_HOST(MYCLONE, W) + + !UPDATE VALUES ON THE ORIGINAL + PTR = 42 + !CHECK THAT THEY ARE STILL THE SAME IN THE CLONE + IF (.NOT. ALL(MYCLONE%PTR == 7)) THEN + CALL FIELD_ABORT ("ERROR") + END IF + + CALL MYCLONE%GET_HOST_DATA_RDWR(PTR2) + !UPDATE THE VALUES ON THE CLONE + PTR2 = 11 + !CHECK THAT THEY ARE STILL THE SAME ON THE ORIGINAL + IF (.NOT. ALL(W%PTR == 42)) THEN + CALL FIELD_ABORT ("ERROR") + END IF + + CALL FIELD_DELETE(W) + CALL FIELD_DELETE(MYCLONE) +END PROGRAM TEST_FIELD_CLONE_2 diff --git a/tests/test_field_clone_device.F90 b/tests/test_field_clone_device.F90 new file mode 100644 index 00000000..33c2837c --- /dev/null +++ b/tests/test_field_clone_device.F90 @@ -0,0 +1,50 @@ +! (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_FIELD_CLONE_DEVICE + !TEST IF CLONING WORKS CORRECTLY ON DEVICE + !IT SHOULD CREATE A FIELD_OWNER AND SO LET THE DATA BE + !ACCESSIBLE EVEN THROUGH THE ORIGIN OF THE COPY HAS BEEN DESTROYED + + USE FIELD_MODULE + USE FIELD_FACTORY_MODULE + USE FIELD_CLONE_MODULE, ONLY: FIELD_CLONE_ON_DEVICE + USE PARKIND1 + USE FIELD_ABORT_MODULE + IMPLICIT NONE + REAL(KIND=JPRB) :: D(10) + CLASS(FIELD_1RB), POINTER :: W => NULL() + CLASS(FIELD_1RB), POINTER :: MYCLONE => NULL() + REAL(KIND=JPRB), POINTER :: PTR_DEV(:) => NULL() + INTEGER ::I + LOGICAL :: OKAY + + D = 7 + CALL FIELD_NEW(W, DATA=D) + + CALL FIELD_CLONE_ON_DEVICE(MYCLONE, W) + CALL FIELD_DELETE(W) + + CALL MYCLONE%GET_DEVICE_DATA_RDONLY(PTR_DEV) + OKAY=.TRUE. + !$ACC PARALLEL PRESENT(PTR_DEV) COPY(OKAY) + DO I=1,10 + IF(PTR_DEV(I) /= 7)THEN + OKAY=.FALSE. + ENDIF + ENDDO + !$ACC END PARALLEL + CALL MYCLONE%GET_HOST_DATA_RDONLY(PTR_DEV) + + IF(OKAY .EQV. .FALSE.)THEN + CALL FIELD_ABORT ("ERROR WRONG DATA ON DEVICE") + ENDIF + + CALL FIELD_DELETE(MYCLONE) +END PROGRAM TEST_FIELD_CLONE_DEVICE diff --git a/tests/test_field_clone_null.F90 b/tests/test_field_clone_null.F90 new file mode 100644 index 00000000..60563d78 --- /dev/null +++ b/tests/test_field_clone_null.F90 @@ -0,0 +1,31 @@ +! (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_FIELD_CLONE_NULL + !TEST IF CLONING WORKS CORRECTLY. + !THe CLONE SHOULD BE NULL IF THE ORIGINAL IS NULL + + USE FIELD_MODULE + USE FIELD_FACTORY_MODULE + USE FIELD_CLONE_MODULE, ONLY: FIELD_CLONE_ON_HOST + USE PARKIND1 + USE FIELD_ABORT_MODULE + IMPLICIT NONE + CLASS(FIELD_1RB), POINTER :: W => NULL() + CLASS(FIELD_1RB), POINTER :: MYCLONE => NULL() + + CALL FIELD_CLONE_ON_HOST(MYCLONE, W) + + IF (ASSOCIATED(MYCLONE)) THEN + CALL FIELD_ABORT ("ERROR") + END IF + + CALL FIELD_DELETE(W) + CALL FIELD_DELETE(MYCLONE) +END PROGRAM TEST_FIELD_CLONE_NULL diff --git a/tests/test_field_clone_optional.F90 b/tests/test_field_clone_optional.F90 new file mode 100644 index 00000000..b67f8f05 --- /dev/null +++ b/tests/test_field_clone_optional.F90 @@ -0,0 +1,29 @@ +! (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_FIELD_CLONE_OPTIONAL + !TEST IF CLONING WORKS CORRECTLY. + !THE CLONE SHOULD BE NULL IS THE SOURCE OF THE COPY IS NOT PRESENT + + USE FIELD_MODULE + USE FIELD_FACTORY_MODULE + USE FIELD_CLONE_MODULE, ONLY: FIELD_CLONE_ON_HOST + USE PARKIND1 + USE FIELD_ABORT_MODULE + IMPLICIT NONE + CLASS(FIELD_1RB), POINTER :: MYCLONE => NULL() + + CALL FIELD_CLONE_ON_HOST(MYCLONE) + + IF (ASSOCIATED(MYCLONE)) THEN + CALL FIELD_ABORT ("ERROR") + END IF + + CALL FIELD_DELETE(MYCLONE) +END PROGRAM TEST_FIELD_CLONE_OPTIONAL