Add test for fieldset device operators

Co-authored-by: Willem Deconinck <willem.deconinck@ecmwf.int>

src/tests/field/CMakeLists.txt

@@ -92,6 +92,19 @@ if( HAVE_FCTEST )
     set_tests_properties ( atlas_fctest_field_device PROPERTIES LABELS "gpu;acc")
   endif()
 
+  add_fctest( TARGET atlas_fctest_fieldset_device
+    CONDITION       atlas_HAVE_ACC
+    LINKER_LANGUAGE Fortran
+    SOURCES         fctest_fieldset_gpu.F90
+    LIBS            atlas_f OpenACC::OpenACC_Fortran
+    ENVIRONMENT     ${ATLAS_TEST_ENVIRONMENT} ATLAS_RUN_NGPUS=1
+  )
+
+  if( TARGET atlas_fctest_fieldset_device )
+    set_tests_properties ( atlas_fctest_fieldset_device PROPERTIES LABELS "gpu;acc")
+  endif()
+
+
   add_fctest( TARGET atlas_fctest_field_wrap_device
     CONDITION       atlas_HAVE_ACC
     LINKER_LANGUAGE Fortran

src/tests/field/fctest_fieldset_gpu.F90

@@ -0,0 +1,256 @@
+! (C) Copyright 2013 ECMWF.
+! 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.
+
+! This File contains Unit Tests for testing the
+! C++ / Fortran Interfaces to the State Datastructure
+! @author Willem Deconinck
+! @author Slavko Brdar
+
+#include "fckit/fctest.h"
+
+
+
+! -----------------------------------------------------------------------------
+
+module fcta_FieldSet_gpu_fxt
+  use atlas_module
+  use, intrinsic :: iso_c_binding, only: c_ptr
+  implicit none
+
+contains
+
+  subroutine kernel_host_ptr(view)
+    implicit none
+    real(4), intent(inout) :: view(:,:)
+    !$acc data present(view)
+    !$acc kernels present(view)
+    view(2,1) = 4.
+    !$acc end kernels
+    !$acc end data
+  end subroutine kernel_host_ptr
+
+  subroutine kernel_device_ptr(dview)
+    implicit none
+    real(4) :: dview(:,:)
+    !$acc data deviceptr(dview)
+    !$acc kernels
+    dview(2,1) = 5.
+    !$acc end kernels
+    !$acc end data
+  end subroutine kernel_device_ptr
+
+! -----------------------------------------------------------------------------
+
+end module
+
+! -----------------------------------------------------------------------------
+
+! -----------------------------------------------------------------------------
+
+TESTSUITE_WITH_FIXTURE(fcta_FieldSet_gpu,fcta_FieldSet_gpu_fxt)
+
+! -----------------------------------------------------------------------------
+
+TESTSUITE_INIT
+  call atlas_initialize()
+END_TESTSUITE_INIT
+
+! -----------------------------------------------------------------------------
+
+TESTSUITE_FINALIZE
+  call atlas_finalise()
+END_TESTSUITE_FINALIZE
+
+! -----------------------------------------------------------------------------
+
+TEST( test_fieldset_cummulative_gpu_calls_all_fields )
+implicit none
+type(atlas_FieldSet) :: fset
+type(atlas_Field) :: field
+real(4), pointer :: fview(:,:)
+real(4), pointer :: fview_dev(:,:)
+
+print *, "test_fieldset_cummulative_gpu_calls_all_fields"
+fset = atlas_FieldSet()
+call fset%add(atlas_Field(name="f1", kind=atlas_real(4), shape=[1,2]))
+call fset%add(atlas_Field(name="f2", kind=atlas_real(4), shape=[2,2]))
+call fset%add(atlas_Field(name="f3", kind=atlas_real(4), shape=[2,1]))
+
+print *, "... by idx"
+field = fset%field(2)
+call field%data(fview)
+fview(:,:) = 1.
+fview(2,1) = 2.
+
+call fset%set_host_needs_update(.false.)
+call fset%allocate_device()
+FCTEST_CHECK_EQUAL(field%device_allocated(), .true.)
+call fset%update_device()
+
+!$acc kernels present(fview)
+fview(2,1) = 3.
+!$acc end kernels
+
+FCTEST_CHECK_EQUAL( fview(2,1), 2. )
+call fset%update_host()
+FCTEST_CHECK_EQUAL( fview(2,1), 3. )
+
+call kernel_host_ptr(fview)
+FCTEST_CHECK_EQUAL( fview(2,1), 3. )
+call fset%update_host()
+FCTEST_CHECK_EQUAL( fview(2,1), 4. )
+
+call field%device_data(fview_dev)
+call kernel_device_ptr(fview_dev)
+FCTEST_CHECK_EQUAL( fview(2,1), 4. )
+call fset%update_host()
+FCTEST_CHECK_EQUAL( fview(2,1), 5. )
+
+call fset%deallocate_device()
+
+print *, "... by name"
+field = fset%field("f3")
+call field%data(fview)
+fview(:,:) = 3.
+fview(2,1) = 4.
+
+call fset%allocate_device()
+call fset%update_device()
+
+!$acc kernels present(fview)
+fview(2,1) = 7.
+!$acc end kernels
+
+FCTEST_CHECK_EQUAL( fview(2,1), 4. )
+call fset%update_host()
+FCTEST_CHECK_EQUAL( fview(2,1), 7. )
+
+call fset%final()
+END_TEST
+
+! -----------------------------------------------------------------------------
+
+TEST( test_fieldset_cummulative_gpu_calls_subset_field)
+implicit none
+type(atlas_FieldSet) :: fset
+type(atlas_Field) :: field
+real(4), pointer :: fview(:,:)
+print *, "fieldset_cummulative_gpu_calls subset fields"
+
+fset = atlas_FieldSet()
+call fset%add(atlas_Field(name="f1", kind=atlas_real(4), shape=[1,2]))
+call fset%add(atlas_Field(name="f2", kind=atlas_real(4), shape=[2,2]))
+call fset%add(atlas_Field(name="f3", kind=atlas_real(4), shape=[2,1]))
+
+print *, "... by idx"
+field = fset%field(2)
+call field%data(fview)
+fview(:,:) = 1.
+fview(2,1) = 2.
+
+call fset%set_host_needs_update((/2, 3/), .false.)
+call fset%allocate_device((/ 2, 3 /)) ! device allocate only for field 2 and 3
+call fset%sync_host_device((/ 2, 3 /)) ! device-memcpy for field 2 and 3
+
+!$acc kernels present(fview)
+fview(2,1) = 5.
+!$acc end kernels
+
+call fset%set_host_needs_update((/ 2 /))
+
+FCTEST_CHECK_EQUAL( fview(2,1), 2. )
+call fset%sync_host_device()
+FCTEST_CHECK_EQUAL( fview(2,1), 5. )
+call fset%deallocate_device()
+
+print *, "... by name"
+field = fset%field("f3")
+call field%data(fview)
+fview(:,:) = 3.
+fview(2,1) = 4.
+
+call fset%allocate_device((/ "f2", "f3" /))
+call fset%sync_host_device((/ "f2", "f3" /))
+
+!$acc kernels present(fview)
+fview(2,1) = 7.
+!$acc end kernels
+
+call fset%set_host_needs_update((/ "f3" /))
+
+FCTEST_CHECK_EQUAL( fview(2,1), 4. )
+call fset%sync_host_device()
+FCTEST_CHECK_EQUAL( fview(2,1), 7. )
+
+call fset%final()
+END_TEST
+
+! -----------------------------------------------------------------------------
+
+TEST( test_fieldset_cummulative_gpu_calls_with_sync_host_device)
+implicit none
+type(atlas_FieldSet) :: fset
+type(atlas_Field) :: field
+real(4), pointer :: fview(:,:)
+
+print *, "test_fieldset_cummulative_gpu_calls_with_sync_host_device"
+fset = atlas_FieldSet()
+call fset%add(atlas_Field(name="f1", kind=atlas_real(4), shape=[1,2]))
+call fset%add(atlas_Field(name="f2", kind=atlas_real(4), shape=[2,2]))
+call fset%add(atlas_Field(name="f3", kind=atlas_real(4), shape=[2,1]))
+
+print *, "... by idx"
+field = fset%field(2)
+call field%data(fview)
+fview(:,:) = 1.
+fview(2,1) = 2.
+
+call fset%set_host_needs_update(.false.)
+call fset%allocate_device((/ 2, 3 /)) ! device allocate only for field 2 and 3
+call fset%set_device_needs_update((/ 2 /))
+call fset%sync_host_device((/ 2 /)) ! device-memcpy for field 2 and 3
+
+!$acc kernels present(fview)
+fview(2,1) = 5.
+!$acc end kernels
+
+call fset%set_host_needs_update((/ 2 /))
+
+FCTEST_CHECK_EQUAL( fview(2,1), 2. )
+call fset%sync_host_device()
+FCTEST_CHECK_EQUAL( fview(2,1), 5. )
+
+call fset%deallocate_device()
+
+print *, "... by name"
+field = fset%field("f2")
+call field%data(fview)
+fview(:,:) = 3.
+fview(2,1) = 4.
+
+call fset%set_host_needs_update(.false.)
+call fset%allocate_device((/ "f2", "f3" /)) ! device allocate only for field 2 and 3
+call fset%set_device_needs_update((/ "f2" /)) ! set fields for sync_host_device
+call fset%sync_host_device((/ "f2" /)) ! device-memcpy for field 'f2'
+
+!$acc kernels present(fview)
+fview(2,1) = 7.
+!$acc end kernels
+
+call fset%set_host_needs_update((/ "f2" /))
+
+FCTEST_CHECK_EQUAL( fview(2,1), 4. )
+call fset%sync_host_device()
+FCTEST_CHECK_EQUAL( fview(2,1), 7. )
+
+call fset%final()
+END_TEST
+
+! -----------------------------------------------------------------------------
+
+END_TESTSUITE
+