Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Modifydiag_field_add_attribute to accept r4 and r8 #1625

Merged
merged 4 commits into from
Jan 2, 2025
Merged
Changes from 3 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
47 changes: 42 additions & 5 deletions diag_manager/diag_manager.F90
Original file line number Diff line number Diff line change
@@ -369,11 +369,8 @@ MODULE diag_manager_mod
!> @brief Add a attribute to the output field
!> @ingroup diag_manager_mod
INTERFACE diag_field_add_attribute
MODULE PROCEDURE diag_field_add_attribute_scalar_r
MODULE PROCEDURE diag_field_add_attribute_scalar_i
MODULE PROCEDURE diag_field_add_attribute_scalar_c
MODULE PROCEDURE diag_field_add_attribute_r1d
MODULE PROCEDURE diag_field_add_attribute_i1d
MODULE PROCEDURE diag_field_add_attribute_1d
MODULE PROCEDURE diag_field_add_attribute_0d
END INTERFACE diag_field_add_attribute

!> @addtogroup diag_manager_mod
@@ -4561,6 +4558,46 @@ SUBROUTINE diag_field_add_attribute_i1d(diag_field_id, att_name, att_value)
endif
END SUBROUTINE diag_field_add_attribute_i1d

!> @brief Add a scalr attribute to the diag field corresponding to a given id
subroutine diag_field_add_attribute_0d(diag_field_id, att_name, att_value)
INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
class(*), INTENT(in) :: att_value !< new attribute value

select type(att_value)
type is (real(kind=r4_kind))
call diag_field_add_attribute_scalar_r(diag_field_id, att_name, real(att_value))
type is (real(kind=r8_kind))
call diag_field_add_attribute_scalar_r(diag_field_id, att_name, real(att_value))
type is (integer(kind=i4_kind))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is enforcing the attribute value to be the same as the default precision specifiec at compile time, shouldn't it be the same as the incoming type-value?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think @bensonr is right here. If I build FMS as r4 then this:

    type is (real(kind=r8_kind))
      call diag_field_add_attribute_scalar_r(diag_field_id, att_name, real(att_value))

will cast the r8 real I pass down into an r4 (since that is what real means).

In my attempt at this, I essentially "doubled up" and made two diag_field_add_attribute_scalar_r4 and a diag_field_add_attribute_scalar_r8 (and similar for the r1d → r41d, r81d)

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In the old diag manager, it ends up always writing the att_value as NF90_FLOAT.

CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=att_value)

In 4829fe8, I made the changes so that the new diag manager uses the actual precision of att_value.

call diag_field_add_attribute_scalar_i(diag_field_id, att_name, att_value)
type is (character(len=*))
call diag_field_add_attribute_scalar_c(diag_field_id, att_name, att_value)
class default
call mpp_error(FATAL, "Diag_field_add_attribute 0d:: unsupported type. The acceptable types "//&
"are float, double, integer, and string")
end select
end subroutine diag_field_add_attribute_0d

!> @brief Add an 1D array attribute to the diag field corresponding to a given id
subroutine diag_field_add_attribute_1d(diag_field_id, att_name, att_value)
INTEGER, INTENT(in) :: diag_field_id !< ID number for field to add attribute to
CHARACTER(len=*), INTENT(in) :: att_name !< new attribute name
class(*), INTENT(in) :: att_value(:) !< new attribute value

select type(att_value)
type is (real(kind=r4_kind))
call diag_field_add_attribute_r1d(diag_field_id, att_name, real(att_value))
type is (real(kind=r8_kind))
call diag_field_add_attribute_r1d(diag_field_id, att_name, real(att_value))
type is (integer(kind=i4_kind))
call diag_field_add_attribute_i1d(diag_field_id, att_name, att_value)
class default
call mpp_error(FATAL, "Diag_field_add_attribute 1d:: unsupported type. The acceptable types "//&
"are float, double, and integer")
end select
end subroutine diag_field_add_attribute_1d

!> @brief Add the cell_measures attribute to a diag out field
!!
!> Add the cell_measures attribute to a give diag field. This is useful if the
7 changes: 4 additions & 3 deletions test_fms/diag_manager/Makefile.am
Original file line number Diff line number Diff line change
@@ -34,7 +34,7 @@ check_PROGRAMS = test_diag_manager test_diag_manager_time \
check_time_min check_time_max check_time_sum check_time_avg test_diag_diurnal check_time_diurnal \
check_time_pow check_time_rms check_subregional test_cell_measures test_var_masks \
check_var_masks test_multiple_send_data test_diag_out_yaml test_output_every_freq \
test_dm_weights test_prepend_date test_ens_runs
test_dm_weights test_prepend_date test_ens_runs test_diag_attribute_add

# This is the source code for the test.
test_output_every_freq_SOURCES = test_output_every_freq.F90
@@ -66,6 +66,7 @@ check_var_masks_SOURCES = check_var_masks.F90
test_multiple_send_data_SOURCES = test_multiple_send_data.F90
test_prepend_date_SOURCES = test_prepend_date.F90
test_ens_runs_SOURCES = test_ens_runs.F90
test_diag_attribute_add_SOURCES = test_diag_attribute_add.F90

TEST_EXTENSIONS = .sh
SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
@@ -75,7 +76,7 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
TESTS = test_diag_manager2.sh test_time_none.sh test_time_min.sh test_time_max.sh test_time_sum.sh \
test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh test_cell_measures.sh \
test_subregional.sh test_var_masks.sh test_multiple_send_data.sh test_output_every_freq.sh \
test_dm_weights.sh test_flush_nc_file.sh test_prepend_date.sh test_ens_runs.sh
test_dm_weights.sh test_flush_nc_file.sh test_prepend_date.sh test_ens_runs.sh test_diag_attribute_add.sh

testing_utils.mod: testing_utils.$(OBJEXT)

@@ -84,7 +85,7 @@ EXTRA_DIST = test_diag_manager2.sh check_crashes.sh test_time_none.sh test_time_
test_time_sum.sh test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh \
test_cell_measures.sh test_subregional.sh test_var_masks.sh test_multiple_send_data.sh \
test_flush_nc_file.sh test_dm_weights.sh test_output_every_freq.sh test_prepend_date.sh \
test_ens_runs.sh
test_ens_runs.sh test_diag_attribute_add.sh

if USING_YAML
skipflag=""
120 changes: 120 additions & 0 deletions test_fms/diag_manager/test_diag_attribute_add.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,120 @@
!***********************************************************************
!* GNU Lesser General Public License
!*
!* This file is part of the GFDL Flexible Modeling System (FMS).
!*
!* FMS is free software: you can redistribute it and/or modify it under
!* the terms of the GNU Lesser General Public License as published by
!* the Free Software Foundation, either version 3 of the License, or (at
!* your option) any later version.
!*
!* FMS is distributed in the hope that it will be useful, but WITHOUT
!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
!* for more details.
!*
!* You should have received a copy of the GNU Lesser General Public
!* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
!***********************************************************************

program test_diag_attribute_add
use platform_mod, only: r4_kind, r8_kind
use mpp_mod, only: FATAL, mpp_error
use fms_mod, only: fms_init, fms_end
use diag_manager_mod, only: diag_axis_init, register_static_field, diag_send_complete, send_data
use diag_manager_mod, only: register_diag_field, diag_field_add_attribute
use diag_manager_mod, only: diag_manager_init, diag_manager_end, diag_manager_set_time_end
use time_manager_mod, only: time_type, set_calendar_type, set_date, JULIAN, set_time, OPERATOR(+)
use fms2_io_mod

implicit none

integer :: id_potatoes
integer :: i
type(time_type) :: Time
type(time_type) :: Time_step
logical :: used
real(kind=r4_kind) :: fbuffer(2) = (/ 13., 14./)
real(kind=r8_kind) :: dbuffer(2) = (/ 23., 24./)
integer :: ibuffer(2) = (/ 551, 552/)
character(len=20) :: cbuffer = "Hello World"

call fms_init()
call set_calendar_type(JULIAN)
call diag_manager_init()

Time = set_date(2,1,1,0,0,0)
Time_step = set_time (3600*4,0)
call diag_manager_set_time_end(set_date(2,1,2,0,0,0))

id_potatoes = register_diag_field ('food_mod', 'potatoes', init_time=Time)
call diag_field_add_attribute(id_potatoes, "real_32", fbuffer(1))
call diag_field_add_attribute(id_potatoes, "real_32_1d", fbuffer)
call diag_field_add_attribute(id_potatoes, "real_64", dbuffer(1))
call diag_field_add_attribute(id_potatoes, "real_64_1d", dbuffer )
call diag_field_add_attribute(id_potatoes, "integer", ibuffer(1))
call diag_field_add_attribute(id_potatoes, "integer_1d", ibuffer)
call diag_field_add_attribute(id_potatoes, "some_string", cbuffer)

do i = 1, 6
Time = Time + Time_step
used = send_data(id_potatoes, real(103.201), Time)
call diag_send_complete(Time_step)
enddo

call diag_manager_end(Time)

call check_output()
call fms_end()

contains

subroutine check_output()
type(FmsNetcdfFile_t) :: fileobj !< FMS2io fileobj
character(len=256) :: cbuffer_out !< Buffer to read stuff into
integer :: ibuffer_out(2)
real(kind=r4_kind) :: fbuffer_out(2)
real(kind=r8_kind) :: dbuffer_out(2)

if (.not. open_file(fileobj, "food_file.nc", "read")) &
call mpp_error(FATAL, "food_file.nc was not created by the diag manager!")
if (.not. variable_exists(fileobj, "potatoes")) &
call mpp_error(FATAL, "potatoes is not in food_file.nc")

!! Checking the string attributes
call get_variable_attribute(fileobj, "potatoes", "some_string", cbuffer_out)
if (trim(cbuffer_out) .ne. trim(cbuffer)) call mpp_error(FATAL, "some_string is not the expected attribute")

!! Checking the integer attributes
ibuffer_out = -999
call get_variable_attribute(fileobj, "potatoes", "integer", ibuffer_out(1))
if (ibuffer(1) .ne. ibuffer_out(1)) call mpp_error(FATAL, "integer is not the expected attribute")

ibuffer_out = -999
call get_variable_attribute(fileobj, "potatoes", "integer_1d", ibuffer_out)
if (ibuffer(1) .ne. ibuffer_out(1)) call mpp_error(FATAL, "integer_1d is not the expected attribute")
if (ibuffer(2) .ne. ibuffer_out(2)) call mpp_error(FATAL, "integer_1d is not the expected attribute")

!! Checking the double attributes
dbuffer_out = -999
call get_variable_attribute(fileobj, "potatoes", "real_64", dbuffer_out(1))
if (dbuffer(1) .ne. dbuffer_out(1)) call mpp_error(FATAL, "real_64 is not the expected attribute")

dbuffer_out = -999
call get_variable_attribute(fileobj, "potatoes", "real_64_1d", dbuffer_out)
if (dbuffer(1) .ne. dbuffer_out(1)) call mpp_error(FATAL, "real_64_1d is not the expected attribute")
if (dbuffer(2) .ne. dbuffer_out(2)) call mpp_error(FATAL, "real_64_1d is not the expected attribute")

!! Checking the float attributes
fbuffer_out = -999
call get_variable_attribute(fileobj, "potatoes", "real_32", fbuffer_out(1))
if (fbuffer(1) .ne. fbuffer_out(1)) call mpp_error(FATAL, "real_32 is not the expected attribute")

fbuffer_out = -999
call get_variable_attribute(fileobj, "potatoes", "real_32_1d", fbuffer_out)
if (fbuffer(1) .ne. fbuffer_out(1)) call mpp_error(FATAL, "real_32_1d is not the expected attribute")
if (fbuffer(2) .ne. fbuffer_out(2)) call mpp_error(FATAL, "real_32_1d is not the expected attribute")

call close_file(fileobj)
end subroutine check_output
end program test_diag_attribute_add
60 changes: 60 additions & 0 deletions test_fms/diag_manager/test_diag_attribute_add.sh
Original file line number Diff line number Diff line change
@@ -0,0 +1,60 @@
#!/bin/sh

#***********************************************************************
#* GNU Lesser General Public License
#*
#* This file is part of the GFDL Flexible Modeling System (FMS).
#*
#* FMS is free software: you can redistribute it and/or modify it under
#* the terms of the GNU Lesser General Public License as published by
#* the Free Software Foundation, either version 3 of the License, or (at
#* your option) any later version.
#*
#* FMS is distributed in the hope that it will be useful, but WITHOUT
#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
#* for more details.
#*
#* You should have received a copy of the GNU Lesser General Public
#* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
#***********************************************************************

# Set common test settings.
. ../test-lib.sh

if [ -z "${skipflag}" ]; then
# create and enter directory for in/output files
output_dir

cat <<_EOF > diag_table.yaml
title: test_diag_manager
base_date: 2 1 1 0 0 0

diag_files:
- file_name: food_file
freq: 4 hours
time_units: hours
unlimdim: time
reduction: none
kind: r4
module: food_mod
varlist:
- var_name: potatoes
_EOF

# remove any existing files that would result in false passes during checks
rm -f *.nc

my_test_count=1
cat <<_EOF > input.nml
&diag_manager_nml
use_modern_diag=.true.
max_field_attributes = 10
/
_EOF

test_expect_success "Testing diag_field_attribute_add (test $my_test_count)" '
mpirun -n 1 ../test_diag_attribute_add
'
fi
test_done