Skip to content

Commit

Permalink
fix: move mask from input buffer object to field object (NOAA-GFDL#1411)
Browse files Browse the repository at this point in the history
  • Loading branch information
@rem1776
rem1776 authored and rem1776 committed May 1, 2024
1 parent eec36ba commit b2f51e6
Show file tree
Hide file tree
Showing 3 changed files with 67 additions and 32 deletions.
77 changes: 61 additions & 16 deletions diag_manager/fms_diag_field_object.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,7 @@ module fms_diag_field_object_mod
logical, allocatable :: buffer_allocated !< True if a buffer pointed by
!! the corresponding index in
!! buffer_ids(:) is allocated.
logical, allocatable :: mask(:,:,:,:) !< Mask passed in send_data
contains
! procedure :: send_data => fms_send_data !!TODO
! Get ID functions
Expand Down Expand Up @@ -165,6 +166,8 @@ module fms_diag_field_object_mod
procedure :: add_area_volume
procedure :: append_time_cell_methods
procedure :: get_file_ids
procedure :: set_mask
procedure :: allocate_mask
end type fmsDiagField_type
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
type(fmsDiagField_type) :: null_ob
Expand Down Expand Up @@ -394,10 +397,9 @@ subroutine set_vartype(objin , var)
end subroutine set_vartype

!> @brief Adds the input data to the buffered data.
subroutine set_data_buffer (this, input_data, mask, weight, is, js, ks, ie, je, ke)
subroutine set_data_buffer (this, input_data, weight, is, js, ks, ie, je, ke)
class (fmsDiagField_type) , intent(inout):: this !< The field object
class(*), intent(in) :: input_data(:,:,:,:) !< The input array
logical, intent(in) :: mask(:,:,:,:) !< The field mask
real(kind=r8_kind), intent(in) :: weight !< The field weight
integer, intent(in) :: is, js, ks !< Starting indicies of the field_data relative
!! to the compute domain (1 based)
Expand All @@ -408,7 +410,7 @@ subroutine set_data_buffer (this, input_data, mask, weight, is, js, ks, ie, je,
if (.not.this%data_buffer_is_allocated) &
call mpp_error ("set_data_buffer", "The data buffer for the field "//trim(this%varname)//" was unable to be "//&
"allocated.", FATAL)
err_msg = this%input_data_buffer%set_input_buffer_object(input_data, weight, mask, is, js, ks, ie, je, ke)
err_msg = this%input_data_buffer%set_input_buffer_object(input_data, weight, is, js, ks, ie, je, ke)
if (trim(err_msg) .ne. "") call mpp_error(FATAL, "Field:"//trim(this%varname)//" -"//trim(err_msg))

end subroutine set_data_buffer
Expand Down Expand Up @@ -1239,19 +1241,6 @@ function get_data_buffer (this) &
rslt => this%input_data_buffer%get_buffer()
end function get_data_buffer

!> @brief Gets a fields mask buffer
!! @return a pointer to the mask buffer
function get_mask (this) &
result(rslt)
class (fmsDiagField_type), target, intent(in) :: this !< diag field
logical, dimension(:,:,:,:), pointer :: rslt

if (.not. this%data_buffer_is_allocated) &
call mpp_error(FATAL, "The input data buffer for the field:"&
//trim(this%varname)//" was never allocated.")

rslt => this%input_data_buffer%get_mask()
end function get_mask

!> @brief Gets a fields weight buffer
!! @return a pointer to the weight buffer
Expand Down Expand Up @@ -1647,5 +1636,61 @@ pure function get_file_ids(this)
get_file_ids = this%file_ids
end function

!> @brief Get the mask from the input buffer object
!! @return a pointer to the mask
function get_mask(this)
class(fmsDiagField_type), target, intent(in) :: this !< input buffer object
logical, pointer :: get_mask(:,:,:,:)
get_mask => this%mask
end function get_mask

!> @brief If in openmp region, omp_axis should be provided in order to allocate to the given axis lengths.
!! Otherwise mask will be allocated to the size of mask_in
subroutine allocate_mask(this, mask_in, omp_axis)
class(fmsDiagField_type), target, intent(inout) :: this !< input buffer object
logical, intent(in) :: mask_in(:,:,:,:)
class(fmsDiagAxisContainer_type), intent(in), optional :: omp_axis(:) !< true if calling from omp region
integer :: axis_num, length(4)
integer, pointer :: id_num
if(allocated(this%mask)) then
call mpp_error(NOTE,"set_mask:: mask already allocated for field"//this%longname)
deallocate(this%mask)
endif
! if not omp just allocate to whatever is given
if(.not. present(omp_axis)) then
allocate(this%mask(size(mask_in,1), size(mask_in,2), size(mask_in,3), &
size(mask_in,4)))
! otherwise loop through axis and get sizes
else
length = 1
do axis_num=1, size(this%axis_ids)
id_num => this%axis_ids(axis_num)
select type(axis => omp_axis(id_num)%axis)
type is (fmsDiagFullAxis_type)
length(axis_num) = axis%axis_length()
end select
enddo
allocate(this%mask(length(1), length(2), length(3), length(4)))
endif
end subroutine allocate_mask

!> Sets previously allocated mask to mask_in at given index ranges
subroutine set_mask(this, mask_in, is, js, ks, ie, je, ke)
class(fmsDiagField_type), intent(inout) :: this
logical, intent(in) :: mask_in(:,:,:,:)
integer, optional, intent(in) :: is, js, ks, ie, je, ke
if(present(is)) then
if(is .lt. lbound(this%mask,1) .or. ie .gt. ubound(this%mask,1) .or. &
js .lt. lbound(this%mask,2) .or. je .gt. ubound(this%mask,2) .or. &
ks .lt. lbound(this%mask,3) .or. ke .gt. ubound(this%mask,3)) then
print *, mpp_pe(), "alloc'd", SHAPE(this%mask), "passed:", is,ie,js,je,ks,ke
call mpp_error(FATAL,"set_mask:: given indices out of bounds for allocated mask")
endif
this%mask(is:ie, js:je, ks:ke, :) = mask_in
else
this%mask = mask_in
endif
end subroutine set_mask

#endif
end module fms_diag_field_object_mod
16 changes: 1 addition & 15 deletions diag_manager/fms_diag_input_buffer.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,12 +34,10 @@ module fms_diag_input_buffer_mod
type fmsDiagInputBuffer_t
logical :: initialized !< .True. if the input buffer has been initialized
class(*), allocatable :: buffer(:,:,:,:) !< Input data passed in send_data
logical, allocatable :: mask(:,:,:,:) !< Mask passed in send_data
real(kind=r8_kind) :: weight !< Weight passed in send_data

contains
procedure :: get_buffer
procedure :: get_mask
procedure :: get_weight
procedure :: init => init_input_buffer_object
procedure :: set_input_buffer_object
Expand All @@ -60,15 +58,6 @@ function get_buffer(this) &
buffer => this%buffer
end function get_buffer

!> @brief Get the mask from the input buffer object
!! @return a pointer to the mask
function get_mask(this) &
result(mask)
class(fmsDiagInputBuffer_t), target, intent(in) :: this !< input buffer object
logical, pointer :: mask(:,:,:,:)

mask => this%mask
end function get_mask

!> @brief Get the weight from the input buffer object
!! @return a pointer to the weight
Expand Down Expand Up @@ -111,7 +100,6 @@ function init_input_buffer_object(this, input_data, axis_ids, diag_axis) &
end select
enddo axis_loop

allocate(this%mask(length(1), length(2), length(3), length(4)))
select type (input_data)
type is (real(r4_kind))
allocate(real(kind=r4_kind) :: this%buffer(length(1), length(2), length(3), length(4)))
Expand All @@ -132,13 +120,12 @@ end function init_input_buffer_object

!> @brief Sets the members of the input buffer object
!! @return Error message if something went wrong
function set_input_buffer_object(this, input_data, weight, mask, is, js, ks, ie, je, ke) &
function set_input_buffer_object(this, input_data, weight, is, js, ks, ie, je, ke) &
result(err_msg)

class(fmsDiagInputBuffer_t), intent(inout) :: this !< input buffer object
class(*), intent(in) :: input_data(:,:,:,:) !< Field data
real(kind=r8_kind), intent(in) :: weight !< Weight for the field
logical, intent(in) :: mask(:,:,:,:) !< Mask for the field
integer, intent(in) :: is, js, ks !< Starting index for each of the dimension
integer, intent(in) :: ie, je, ke !< Ending index for each of the dimensions

Expand All @@ -150,7 +137,6 @@ function set_input_buffer_object(this, input_data, weight, mask, is, js, ks, ie,
return
endif

this%mask(is:ie, js:je, ks:ke, :) = mask
this%weight = weight

select type (input_data)
Expand Down
6 changes: 5 additions & 1 deletion diag_manager/fms_diag_object.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -602,12 +602,14 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm
if (.not. this%FMS_diag_fields(diag_field_id)%is_data_buffer_allocated()) then
data_buffer_is_allocated = &
this%FMS_diag_fields(diag_field_id)%allocate_data_buffer(field_data, this%diag_axis)
call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask, this%diag_axis)
endif
call this%FMS_diag_fields(diag_field_id)%set_data_buffer_is_allocated(.TRUE.)
call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.TRUE.)
!$omp end critical
call this%FMS_diag_fields(diag_field_id)%set_data_buffer(field_data, oor_mask, field_weight, &
call this%FMS_diag_fields(diag_field_id)%set_data_buffer(field_data, field_weight, &
is, js, ks, ie, je, ke)
call this%FMS_diag_fields(diag_field_id)%set_mask(oor_mask, is, js, ks, ie, je, ke)
fms_diag_accept_data = .TRUE.
return
else
Expand All @@ -619,6 +621,8 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm
bounds, using_blocking, Time=Time)
if (trim(error_string) .ne. "") call mpp_error(FATAL, trim(error_string)//". "//trim(field_info))
call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.FALSE.)
call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask)
call this%FMS_diag_fields(diag_field_id)%set_mask(oor_mask)
return
end if main_if
!> Return false if nothing is done
Expand Down

0 comments on commit b2f51e6

Please sign in to comment.