Added FIELD_CLONE constructor

field_factory_module.fypp

@@ -35,6 +35,14 @@ END INTERFACE FIELD_DELETE
 
 PUBLIC :: FIELD_DELETE
 
+INTERFACE FIELD_CLONE
+#:for ft in fieldTypeList
+  MODULE PROCEDURE ${ft.name}$_CLONE
+#:endfor
+END INTERFACE FIELD_CLONE
+
+PUBLIC :: FIELD_CLONE
+
 CONTAINS
 
 #:for ft in fieldTypeList
@@ -81,6 +89,29 @@ NULLIFY (FIELD_PTR)
 
 END SUBROUTINE 
 
+SUBROUTINE ${ft.name}$_CLONE (OLDOBJ, NEWOBJ)
+
+CLASS(${ft.name}$), POINTER, INTENT(IN) :: OLDOBJ
+CLASS(${ft.name}$), POINTER, INTENT(OUT) :: NEWOBJ
+
+IF(.NOT. ASSOCIATED(OLDOBJ))THEN
+  CALL ABOR1 ('${ft.name}$_CLONE: CANNOT CLONE UNINITIALIZED FIELD')
+ENDIF
+
+SELECT TYPE(OLDOBJ)
+   TYPE IS(${ft.name}$_OWNER)
+      ALLOCATE(${ft.name}$_OWNER::NEWOBJ)
+      CALL FIELD_NEW(NEWOBJ, LBOUNDS=LBOUND(OLDOBJ%PTR), UBOUNDS=UBOUND(OLDOBJ%PTR), PERSISTENT=.NOT. OLDOBJ%THREAD_BUFFER, &
+ &                     DELAYED=OLDOBJ%ISTATUS == INT(B'00000100', KIND=JPIM))
+   TYPE IS(${ft.name}$_WRAPPER)
+      ALLOCATE(${ft.name}$_WRAPPER::NEWOBJ)
+      CALL FIELD_NEW(NEWOBJ, DATA=OLDOBJ%PTR, LBOUNDS=LBOUND(OLDOBJ%PTR), PERSISTENT=.NOT. OLDOBJ%THREAD_BUFFER)
+   CLASS DEFAULT
+      CALL ABOR1 ('${ft.name}$_CLONE: MUST NEVER ARRIVE HERE')
+END SELECT
+
+END SUBROUTINE ${ft.name}$_CLONE
+
 #:endfor
 
 END MODULE

tests/CMakeLists.txt

@@ -40,6 +40,7 @@ list(APPEND TEST_FILES
 	sync_device.F90
 	sync_host.F90
 	wrapper_modify_gpu.F90
+	wrapper_clone.F90
 	)
 
 foreach(TEST_FILE ${TEST_FILES})

tests/wrapper_clone.F90

@@ -0,0 +1,51 @@
+! (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 WRAPPER_CLONE
+        ! TEST IF WRAPPER IS REALLY WRAPPING DATA
+        ! IF IT IS WRAPPING THEN MODIFYING THE WRAPED DATA SHOULD BE SEEN IN
+        ! WRAPPER TOO
+
+        USE FIELD_MODULE
+        USE FIELD_FACTORY_MODULE
+        USE PARKIND1
+        IMPLICIT NONE
+        CLASS(FIELD_2RB), POINTER :: W => NULL()
+        CLASS(FIELD_2RB), POINTER :: O => NULL()
+        REAL(KIND=JPRB), ALLOCATABLE :: D(:,:)
+
+        ALLOCATE(D(10,10))
+        D=7
+
+        CALL FIELD_NEW(W, DATA=D)
+        D=42
+
+        CALL FIELD_CLONE(OLDOBJ=W, NEWOBJ=O)
+
+        IF (.NOT. ALL(W%PTR == 42)) THEN
+                ERROR STOP
+        END IF
+        IF (.NOT. ALL(O%PTR == 42)) THEN
+                ERROR STOP
+        END IF 
+
+        CALL FIELD_DELETE(W)
+
+        IF (.NOT. ASSOCIATED(O%PTR)) THEN
+                ERROR STOP
+        END IF
+
+        CALL O%FINAL()
+
+        IF (ASSOCIATED(O%PTR)) THEN
+                ERROR STOP
+        END IF
+
+        CALL FIELD_DELETE(O)
+END PROGRAM WRAPPER_CLONE