Skip to content

Commit

Permalink
feat: Modern_diag_manager add send data 4d (NOAA-GFDL#1402)
Browse files Browse the repository at this point in the history
  • Loading branch information
uramirez8707 authored and rem1776 committed May 1, 2024
1 parent b2f51e6 commit 6335ec7
Show file tree
Hide file tree
Showing 10 changed files with 118 additions and 6 deletions.
52 changes: 52 additions & 0 deletions diag_manager/diag_manager.F90
Original file line number Diff line number Diff line change
Expand Up @@ -343,6 +343,7 @@ MODULE diag_manager_mod
MODULE PROCEDURE send_data_1d
MODULE PROCEDURE send_data_2d
MODULE PROCEDURE send_data_3d
MODULE PROCEDURE send_data_4d
END INTERFACE

!> @brief Register a diagnostic field for a given module
Expand Down Expand Up @@ -3472,6 +3473,57 @@ LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in,
endIF modern_if
END FUNCTION diag_send_data

!> @brief Updates the output buffer for a field based on the data for current time step
!! @return true if send is successful
LOGICAL FUNCTION send_data_4d(diag_field_id, field, time, is_in, js_in, ks_in, &
& mask, rmask, ie_in, je_in, ke_in, weight, err_msg)
INTEGER, INTENT(in) :: diag_field_id !< The field id returned from the register call
CLASS(*), INTENT(in) :: field(:,:,:,:) !< The field data for the current time step
CLASS(*), INTENT(in), OPTIONAL :: weight !< The weight to multiply the data by when averaging
TYPE (time_type), INTENT(in), OPTIONAL :: time !< The current model time
INTEGER, INTENT(in), OPTIONAL :: is_in !< Starting i index of the data
INTEGER, INTENT(in), OPTIONAL :: js_in !< Starting j index of the data
INTEGER, INTENT(in), OPTIONAL :: ks_in !< Starting k index of the data
INTEGER, INTENT(in), OPTIONAL :: ie_in !< Ending i index of the data
INTEGER, INTENT(in), OPTIONAL :: je_in !< Ending j index of the data
INTEGER, INTENT(in), OPTIONAL :: ke_in !< Ending k index of the data
LOGICAL, INTENT(in), OPTIONAL :: mask(:,:,:,:) !< Logical mask indicating the points to not average
CLASS(*), INTENT(in), OPTIONAL :: rmask(:,:,:,:) !< Real mask indicating the points to not averafe
CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< If some errors occurs, send_data will return the
!! error message instead of crashing

class(*), allocatable :: rmask_local(:,:,:,:) !< Real version of the mask variable
logical, allocatable :: mask_local(:,:,:,:) !< Local version of the mask variable

! If diag_field_id is < 0 it means that this field is not registered, simply return
IF ( diag_field_id <= 0 ) THEN
send_data_4d = .FALSE.
RETURN
ENDIF

if (.not. use_modern_diag) &
call mpp_error(FATAL, "Send_data_4d is only supported when diag_manager_nml::use_modern_diag=.true.")

!< The error checking is done in accept_data
if (present(mask)) mask_local = mask
if (present(rmask)) rmask_local = rmask

send_data_4d = fms_diag_object%fms_diag_accept_data(diag_field_id, field, mask_local, rmask_local, &
time, is_in, js_in, ks_in, ie_in, je_in, ke_in, weight, &
err_msg)

if (present(err_msg)) then
if (err_msg .ne. "") then
call mpp_error(NOTE, trim(err_msg))
send_data_4d = .false.
return
endif
endif

if (allocated(rmask_local)) deallocate(rmask_local)
if (allocated(mask_local)) deallocate(mask_local)
end function send_data_4d

!> @return true if send is successful
LOGICAL FUNCTION send_tile_averaged_data1d ( id, field, area, time, mask )
INTEGER, INTENT(in) :: id !< id od the diagnostic field
Expand Down
6 changes: 6 additions & 0 deletions test_fms/diag_manager/check_time_max.F90
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,12 @@ program check_time_max
call read_data(fileobj, "var3_max", cdata_out(:,:,:,1), unlim_dim_level=i)
call check_data_3d(cdata_out(:,:,:,1), i, .false.)

cdata_out = -999_r4_kind
print *, "Checking answers for var4_max - time_level:", string(i)
call read_data(fileobj, "var4_max", cdata_out(:,:,:,:), unlim_dim_level=i)
call check_data_3d(cdata_out(:,:,:,1), i, .false.)
call check_data_3d(cdata_out(:,:,:,2), i, .false.)

cdata_out = -999_r4_kind
print *, "Checking answers for var3_Z_max - time_level:", string(i)
call read_data(fileobj, "var3_Z_max", cdata_out(:,:,1:2,1), unlim_dim_level=i)
Expand Down
6 changes: 6 additions & 0 deletions test_fms/diag_manager/check_time_min.F90
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,12 @@ program check_time_min
call read_data(fileobj, "var3_min", cdata_out(:,:,:,1), unlim_dim_level=i)
call check_data_3d(cdata_out(:,:,:,1), i, .false.)

cdata_out = -999_r4_kind
print *, "Checking answers for var4_min - time_level:", string(i)
call read_data(fileobj, "var4_min", cdata_out(:,:,:,:), unlim_dim_level=i)
call check_data_3d(cdata_out(:,:,:,1), i, .false.)
call check_data_3d(cdata_out(:,:,:,2), i, .false.)

cdata_out = -999_r4_kind
print *, "Checking answers for var3_Z_min - time_level:", string(i)
call read_data(fileobj, "var3_Z_min", cdata_out(:,:,1:2,1), unlim_dim_level=i)
Expand Down
6 changes: 6 additions & 0 deletions test_fms/diag_manager/check_time_none.F90
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,12 @@ program check_time_none
call read_data(fileobj, "var3_none", cdata_out(:,:,:,1), unlim_dim_level=i)
call check_data_3d(cdata_out(:,:,:,1), i, .false.)

cdata_out = -999_r4_kind
print *, "Checking answers for var4_none - time_level:", string(i)
call read_data(fileobj, "var4_none", cdata_out(:,:,:,:), unlim_dim_level=i)
call check_data_3d(cdata_out(:,:,:,1), i, .false.)
call check_data_3d(cdata_out(:,:,:,2), i, .false.)

cdata_out = -999_r4_kind
print *, "Checking answers for var3_Z - time_level:", string(i)
call read_data(fileobj, "var3_Z", cdata_out(:,:,1:2,1), unlim_dim_level=i)
Expand Down
6 changes: 6 additions & 0 deletions test_fms/diag_manager/check_time_sum.F90
Original file line number Diff line number Diff line change
Expand Up @@ -93,6 +93,12 @@ program check_time_sum
call read_data(fileobj, "var3_sum", cdata_out(:,:,:,1), unlim_dim_level=ti)
call check_data_3d(cdata_out(:,:,:,1), ti, .false.)

cdata_out = -999_r4_kind
print *, "Checking answers for var4_sum - time_level:", string(ti)
call read_data(fileobj, "var4_sum", cdata_out(:,:,:,:), unlim_dim_level=ti)
call check_data_3d(cdata_out(:,:,:,1), ti, .false.)
call check_data_3d(cdata_out(:,:,:,2), ti, .false.)

cdata_out = -999_r4_kind
print *, "Checking answers for var3_Z - time_level:", string(ti)
call read_data(fileobj, "var3_Z", cdata_out(:,:,1:2,1), unlim_dim_level=ti)
Expand Down
24 changes: 20 additions & 4 deletions test_fms/diag_manager/test_reduction_methods.F90
Original file line number Diff line number Diff line change
Expand Up @@ -133,19 +133,19 @@ program test_reduction_methods
select case (mask_case)
case (logical_mask)
clmask = allocate_logical_mask(isc, iec, jsc, jec, nz, nw)
if (mpp_pe() .eq. 0) clmask(isc, jsc, 1, 1) = .False.
if (mpp_pe() .eq. 0) clmask(isc, jsc, 1, :) = .False.

if (test_case .eq. test_halos) then
dlmask = allocate_logical_mask(isd, ied, jsd, jed, nz, nw)
if (mpp_pe() .eq. 0) dlmask(1+nhalox, 1+nhaloy, 1, 1) = .False.
if (mpp_pe() .eq. 0) dlmask(1+nhalox, 1+nhaloy, 1, :) = .False.
endif
case (real_mask)
crmask = allocate_real_mask(isc, iec, jsc, jec, nz, nw)
if (mpp_pe() .eq. 0) crmask(isc, jsc, 1, 1) = 0_r8_kind
if (mpp_pe() .eq. 0) crmask(isc, jsc, 1, :) = 0_r8_kind

if (test_case .eq. test_halos) then
drmask = allocate_real_mask(isd, ied, jsd, jed, nz, nw)
if (mpp_pe() .eq. 0) drmask(1+nhalox, 1+nhaloy, 1, 1) = 0_r8_kind
if (mpp_pe() .eq. 0) drmask(1+nhalox, 1+nhaloy, 1, :) = 0_r8_kind
endif
end select

Expand Down Expand Up @@ -190,14 +190,17 @@ program test_reduction_methods
used = send_data(id_var1, cdata(:,1,1,1), Time)
used = send_data(id_var2, cdata(:,:,1,1), Time)
used = send_data(id_var3, cdata(:,:,:,1), Time)
used = send_data(id_var4, cdata(:,:,:,:), Time)
case (real_mask)
used = send_data(id_var1, cdata(:,1,1,1), Time, rmask=crmask(:,1,1,1))
used = send_data(id_var2, cdata(:,:,1,1), Time, rmask=crmask(:,:,1,1))
used = send_data(id_var3, cdata(:,:,:,1), Time, rmask=crmask(:,:,:,1))
used = send_data(id_var4, cdata(:,:,:,:), Time, rmask=crmask(:,:,:,:))
case (logical_mask)
used = send_data(id_var1, cdata(:,1,1,1), Time, mask=clmask(:,1,1,1))
used = send_data(id_var2, cdata(:,:,1,1), Time, mask=clmask(:,:,1,1))
used = send_data(id_var3, cdata(:,:,:,1), Time, mask=clmask(:,:,:,1))
used = send_data(id_var4, cdata(:,:,:,:), Time, mask=clmask(:,:,:,:))
end select
case (test_halos)
call set_buffer(ddata, i)
Expand All @@ -208,6 +211,8 @@ program test_reduction_methods
is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1)
used = send_data(id_var3, ddata(:,:,:,1), Time, &
is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1)
used = send_data(id_var4, ddata(:,:,:,:), Time, &
is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1)
case (real_mask)
used = send_data(id_var1, cdata(:,1,1,1), Time, &
rmask=crmask(:,1,1,1))
Expand All @@ -217,6 +222,9 @@ program test_reduction_methods
used = send_data(id_var3, ddata(:,:,:,1), Time, &
is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1, &
rmask=drmask(:,:,:,1))
used = send_data(id_var4, ddata(:,:,:,:), Time, &
is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1, &
rmask=drmask(:,:,:,:))
case (logical_mask)
used = send_data(id_var1, cdata(:,1,1,1), Time, &
mask=clmask(:,1,1,1))
Expand All @@ -226,6 +234,9 @@ program test_reduction_methods
used = send_data(id_var3, ddata(:,:,:,1), Time, &
is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1, &
mask=dlmask(:,:,:,1))
used = send_data(id_var4, ddata(:,:,:,:), Time, &
is_in=isd1, ie_in=ied1, js_in=jsd1, je_in=jed1, &
mask=dlmask(:,:,:,:))
end select
case (test_openmp)
select case(mask_case)
Expand Down Expand Up @@ -255,16 +266,21 @@ program test_reduction_methods
case (no_mask)
used=send_data(id_var2, cdata(is1:ie1, js1:je1, 1, 1), time, is_in=is1, js_in=js1)
used=send_data(id_var3, cdata(is1:ie1, js1:je1, :, 1), time, is_in=is1, js_in=js1)
used=send_data(id_var4, cdata(is1:ie1, js1:je1, :, :), time, is_in=is1, js_in=js1)
case (real_mask)
used=send_data(id_var2, cdata(is1:ie1, js1:je1, 1, 1), time, is_in=is1, js_in=js1, &
rmask=crmask(is1:ie1, js1:je1, 1, 1))
used=send_data(id_var3, cdata(is1:ie1, js1:je1, :, 1), time, is_in=is1, js_in=js1, &
rmask=crmask(is1:ie1, js1:je1, :, 1))
used=send_data(id_var4, cdata(is1:ie1, js1:je1, :, :), time, is_in=is1, js_in=js1, &
rmask=crmask(is1:ie1, js1:je1, :, :))
case (logical_mask)
used=send_data(id_var2, cdata(is1:ie1, js1:je1, 1, 1), time, is_in=is1, js_in=js1, &
mask=clmask(is1:ie1, js1:je1, 1, 1))
used=send_data(id_var3, cdata(is1:ie1, js1:je1, :, 1), time, is_in=is1, js_in=js1, &
mask=clmask(is1:ie1, js1:je1, :, 1))
used=send_data(id_var4, cdata(is1:ie1, js1:je1, :, :), time, is_in=is1, js_in=js1, &
mask=clmask(is1:ie1, js1:je1, :, :))
end select
enddo
end select
Expand Down
9 changes: 7 additions & 2 deletions test_fms/diag_manager/test_time_max.sh
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,11 @@ diag_files:
output_name: var3_max
reduction: max
kind: r4
- module: ocn_mod
var_name: var4
output_name: var4_max
reduction: max
kind: r4
- module: ocn_mod
var_name: var3
output_name: var3_Z_max
Expand Down Expand Up @@ -110,7 +115,7 @@ test_expect_success "Checking answers for the "max" reduction method, real mask
mpirun -n 1 ../check_time_max
'

export OMP_NUM_THREADS=1
export OMP_NUM_THREADS=2
my_test_count=`expr $my_test_count + 1`
printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 1 \n \n/" | cat > input.nml
test_expect_success "Running diag_manager with "max" reduction method with openmp (test $my_test_count)" '
Expand All @@ -137,7 +142,7 @@ test_expect_success "Running diag_manager with "max" reduction method with openm
test_expect_success "Checking answers for the "max" reduction method with openmp, real mask (test $my_test_count)" '
mpirun -n 1 ../check_time_max
'
export OMP_NUM_THREADS=2
export OMP_NUM_THREADS=1

my_test_count=`expr $my_test_count + 1`
printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 2 \n \n/" | cat > input.nml
Expand Down
5 changes: 5 additions & 0 deletions test_fms/diag_manager/test_time_min.sh
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,11 @@ diag_files:
output_name: var3_min
reduction: min
kind: r4
- module: ocn_mod
var_name: var4
output_name: var4_min
reduction: min
kind: r4
- module: ocn_mod
var_name: var3
output_name: var3_Z_min
Expand Down
5 changes: 5 additions & 0 deletions test_fms/diag_manager/test_time_none.sh
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,11 @@ diag_files:
output_name: var3_none
reduction: none
kind: r4
- module: ocn_mod
var_name: var4
output_name: var4_none
reduction: none
kind: r4
- module: ocn_mod
var_name: var3
output_name: var3_Z
Expand Down
5 changes: 5 additions & 0 deletions test_fms/diag_manager/test_time_sum.sh
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,11 @@ diag_files:
output_name: var3_sum
reduction: sum
kind: r4
- module: ocn_mod
var_name: var4
output_name: var4_sum
reduction: sum
kind: r4
- module: ocn_mod
var_name: var3
output_name: var3_Z
Expand Down

0 comments on commit 6335ec7

Please sign in to comment.