Skip to content

Commit

Permalink
1) add missing GPU operators on FieldSet; 2) tweak unit tests
Browse files Browse the repository at this point in the history
  • Loading branch information
sbrdar committed Oct 10, 2024
1 parent 9fe3543 commit 719b63e
Show file tree
Hide file tree
Showing 4 changed files with 393 additions and 14 deletions.
357 changes: 357 additions & 0 deletions src/atlas_f/field/atlas_FieldSet_module.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,32 @@ contains

procedure, private :: dummy

procedure, public :: set_host_needs_update_idx
procedure, public :: set_host_needs_update_value
procedure, public :: set_host_needs_update_name
generic :: set_host_needs_update => set_host_needs_update_idx, set_host_needs_update_value, &
set_host_needs_update_name
procedure, public :: set_device_needs_update_idx
procedure, public :: set_device_needs_update_value
procedure, public :: set_device_needs_update_name
generic :: set_device_needs_update => set_device_needs_update_idx, set_device_needs_update_value, &
set_device_needs_update_name
procedure, public :: sync_host_device_idx
procedure, public :: sync_host_device_name
generic :: sync_host_device => sync_host_device_idx, sync_host_device_name
procedure, public :: allocate_device_idx
procedure, public :: allocate_device_name
generic :: allocate_device => allocate_device_idx, allocate_device_name
procedure, public :: update_device_idx
procedure, public :: update_device_name
generic :: update_device => update_device_idx, update_device_name
procedure, public :: update_host_idx
procedure, public :: update_host_name
generic :: update_host => update_host_idx, update_host_name
procedure, public :: deallocate_device_idx
procedure, public :: deallocate_device_name
generic :: deallocate_device => deallocate_device_idx, deallocate_device_name

#if FCKIT_FINAL_NOT_INHERITING
final :: atlas_FieldSet__final_auto
#endif
Expand Down Expand Up @@ -304,6 +330,337 @@ end subroutine

!-------------------------------------------------------------------------------

subroutine set_host_needs_update_value(this, value)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
logical, intent(in), optional :: value
type(atlas_Field) :: field
integer(c_int) :: i, value_int
value_int = 1
if (present(value)) then
if (.not. value) then
value_int = 0
end if
end if
do i = 1, this%size()
field = this%field(i)
call atlas__Field__set_host_needs_update(field%CPTR_PGIBUG_A, value_int)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine set_host_needs_update_idx(this, field_indices, value)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
integer, intent(in) :: field_indices(:)
logical, intent(in), optional :: value
type(atlas_Field) :: field
integer(c_int) :: i, value_int
value_int = 1
if (present(value)) then
if (.not. value) then
value_int = 0
end if
end if
do i = 1, size(field_indices)
field = this%field(field_indices(i))
call atlas__Field__set_host_needs_update(field%CPTR_PGIBUG_A, value_int)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine set_host_needs_update_name(this, field_names, value)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
character(*), intent(in) :: field_names(:)
logical, intent(in), optional :: value
type(atlas_Field) :: field
integer(c_int) :: i, value_int
value_int = 1
if (present(value)) then
if (.not. value) then
value_int = 0
end if
end if
do i = 1, size(field_names)
field = this%field(field_names(i))
call atlas__Field__set_host_needs_update(field%CPTR_PGIBUG_A, value_int)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine set_device_needs_update_value(this, value)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
logical, intent(in), optional :: value
type(atlas_Field) :: field
integer(c_int) :: i, value_int
value_int = 1
if (present(value)) then
if (.not. value) then
value_int = 0
end if
end if
do i = 1, this%size()
field = this%field(i)
call atlas__Field__set_device_needs_update(field%CPTR_PGIBUG_A, value_int)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine set_device_needs_update_idx(this, field_indices, value)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
integer, intent(in) :: field_indices(:)
logical, intent(in), optional :: value
type(atlas_Field) :: field
integer(c_int) :: i, value_int
value_int = 1
if (present(value)) then
if (.not. value) then
value_int = 0
end if
end if
do i = 1, size(field_indices)
field = this%field(field_indices(i))
call atlas__Field__set_device_needs_update(field%CPTR_PGIBUG_A, value_int)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine set_device_needs_update_name(this, field_names, value)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
character(*), intent(in) :: field_names(:)
logical, intent(in), optional :: value
type(atlas_Field) :: field
integer(c_int) :: i, value_int
value_int = 1
if (present(value)) then
if (.not. value) then
value_int = 0
end if
end if
do i = 1, size(field_names)
field = this%field(field_names(i))
call atlas__Field__set_device_needs_update(field%CPTR_PGIBUG_A, value_int)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine sync_host_device_idx(this, field_indices)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
integer, intent(in), optional :: field_indices(:)
type(atlas_Field) :: field
integer(c_int) :: i
if (present(field_indices)) then
do i = 1, size(field_indices)
field = this%field(field_indices(i))
call atlas__Field__sync_host_device(field%CPTR_PGIBUG_A)
end do
else
do i = 1, this%size()
field = this%field(i)
call atlas__Field__sync_host_device(field%CPTR_PGIBUG_A)
end do
end if
end subroutine

!-------------------------------------------------------------------------------

subroutine sync_host_device_name(this, field_names)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
character(*), intent(in) :: field_names(:)
type(atlas_Field) :: field
integer(c_int) :: i
do i = 1, size(field_names)
field = this%field(field_names(i))
call atlas__Field__sync_host_device(field%CPTR_PGIBUG_A)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine allocate_device_idx(this, field_indices)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
integer, intent(in), optional :: field_indices(:)
type(atlas_Field) :: field
integer(c_int) :: i
if (present(field_indices)) then
do i = 1, size(field_indices)
field = this%field(field_indices(i))
call atlas__Field__allocate_device(field%CPTR_PGIBUG_A)
end do
else
do i = 1, this%size()
field = this%field(i)
call atlas__Field__allocate_device(field%CPTR_PGIBUG_A)
end do
end if
end subroutine

!-------------------------------------------------------------------------------

subroutine allocate_device_name(this, field_names)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
character(*), intent(in) :: field_names(:)
type(atlas_Field) :: field
integer(c_int) :: i
do i = 1, size(field_names)
field = this%field(field_names(i))
call atlas__Field__allocate_device(field%CPTR_PGIBUG_A)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine update_device_idx(this, field_indices)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
integer, intent(in), optional :: field_indices(:)
type(atlas_Field) :: field
integer(c_int) :: i
if (present(field_indices)) then
do i = 1, size(field_indices)
field = this%field(field_indices(i))
call atlas__Field__update_device(field%CPTR_PGIBUG_A)
end do
else
do i = 1, this%size()
field = this%field(i)
call atlas__Field__update_device(field%CPTR_PGIBUG_A)
end do
end if
end subroutine

!-------------------------------------------------------------------------------

subroutine update_device_name(this, field_names)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
character(*), intent(in) :: field_names(:)
type(atlas_Field) :: field
integer(c_int) :: i
do i = 1, size(field_names)
field = this%field(field_names(i))
call atlas__Field__update_device(field%CPTR_PGIBUG_A)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine update_host_idx(this, field_indices)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
integer, intent(in), optional :: field_indices(:)
type(atlas_Field) :: field
integer(c_int) :: i
if (present(field_indices)) then
do i = 1, size(field_indices)
field = this%field(field_indices(i))
call atlas__Field__update_host(field%CPTR_PGIBUG_A)
end do
else
do i = 1, this%size()
field = this%field(i)
call atlas__Field__update_host(field%CPTR_PGIBUG_A)
end do
end if
end subroutine

!-------------------------------------------------------------------------------

subroutine update_host_name(this, field_names)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
character(*), intent(in) :: field_names(:)
type(atlas_Field) :: field
integer(c_int) :: i
do i = 1, size(field_names)
field = this%field(field_names(i))
call atlas__Field__update_host(field%CPTR_PGIBUG_A)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine deallocate_device_idx(this, field_indices)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
integer, optional :: field_indices(:)
type(atlas_Field) :: field
integer(c_int) :: i
if (present(field_indices)) then
do i = 1, size(field_indices)
field = this%field(field_indices(i))
call atlas__Field__deallocate_device(field%CPTR_PGIBUG_A)
end do
else
do i = 1, this%size()
field = this%field(i)
call atlas__Field__deallocate_device(field%CPTR_PGIBUG_A)
end do
end if
end subroutine

!-------------------------------------------------------------------------------

subroutine deallocate_device_name(this, field_names)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_field_c_binding
use atlas_Field_module, only: atlas_Field
class(atlas_FieldSet), intent(inout) :: this
character(*), intent(in) :: field_names(:)
type(atlas_Field) :: field
integer(c_int) :: i
do i = 1, size(field_names)
field = this%field(field_names(i))
call atlas__Field__deallocate_device(field%CPTR_PGIBUG_A)
end do
end subroutine

!-------------------------------------------------------------------------------

subroutine set_dirty(this,value)
use, intrinsic :: iso_c_binding, only : c_int
use atlas_fieldset_c_binding
Expand Down
Loading

0 comments on commit 719b63e

Please sign in to comment.