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

Open
wants to merge 4 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all 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
109 changes: 51 additions & 58 deletions diag_manager/diag_manager.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -4496,70 +4493,66 @@ SUBROUTINE diag_field_attribute_init(diag_field_id, name, type, cval, ival, rval
END IF
END SUBROUTINE diag_field_attribute_init

!> @brief Add a scalar real attribute to the diag field corresponding to a given id
SUBROUTINE diag_field_add_attribute_scalar_r(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
REAL, INTENT(in) :: att_value !< new attribute value
!> @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

if (use_modern_diag) then
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
else
CALL diag_field_add_attribute_r1d(diag_field_id, att_name, (/ att_value /))
endif
END SUBROUTINE diag_field_add_attribute_scalar_r

!> @brief Add a scalar integer attribute to the diag field corresponding to a given id
SUBROUTINE diag_field_add_attribute_scalar_i(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
INTEGER, INTENT(in) :: att_value !< new attribute value

if (use_modern_diag) then
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
else
CALL diag_field_add_attribute_i1d(diag_field_id, att_name, (/ att_value /))
endif
END SUBROUTINE diag_field_add_attribute_scalar_i

!> @brief Add a scalar character attribute to the diag field corresponding to a given id
SUBROUTINE diag_field_add_attribute_scalar_c(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
CHARACTER(len=*), INTENT(in) :: att_value !< new attribute value

if (use_modern_diag) then
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
select type(att_value)
type is (real(kind=r4_kind))
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
type is (real(kind=r8_kind))
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
type is (integer(kind=i4_kind))
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, (/att_value /))
type is (character(len=*))
call fms_diag_object%fms_diag_field_add_attribute(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
else
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_CHAR, cval=att_value)
select type(att_value)
type is (real(kind=r4_kind))
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=real((/att_value/)))
type is (real(kind=r8_kind))
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=real((/att_value/)))
Copy link
Contributor

Choose a reason for hiding this comment

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

If a r8 value is coming in, shouldn't this be an NF90_DOUBLE in both?

Copy link
Contributor

Choose a reason for hiding this comment

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

In both routines, not both lines, that is.

type is (integer(kind=i4_kind))
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_INT, ival=(/att_value/))
type is (character(len=*))
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_CHAR, cval=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
endif
END SUBROUTINE diag_field_add_attribute_scalar_c

!> @brief Add a real 1D array attribute to the diag field corresponding to a given id
SUBROUTINE diag_field_add_attribute_r1d(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
REAL, DIMENSION(:), INTENT(in) :: att_value !< new attribute value
end subroutine diag_field_add_attribute_0d

if (use_modern_diag) then
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, att_value)
else
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=att_value)
endif
END SUBROUTINE diag_field_add_attribute_r1d

!> @brief Add an integer 1D array attribute to the diag field corresponding to a given id
SUBROUTINE diag_field_add_attribute_i1d(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
INTEGER, DIMENSION(:), INTENT(in) :: att_value !< new attribute value
!> @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

if (use_modern_diag) then
call fms_diag_object%fms_diag_field_add_attribute(diag_field_id, att_name, att_value)
else
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_INT, ival=att_value)
select type(att_value)
type is (real(kind=r4_kind))
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=real(att_value))
type is (real(kind=r8_kind))
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_FLOAT, rval=real(att_value))
type is (integer(kind=i4_kind))
CALL diag_field_attribute_init(diag_field_id, att_name, NF90_INT, ival=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
endif
END SUBROUTINE diag_field_add_attribute_i1d
end subroutine diag_field_add_attribute_1d

!> @brief Add the cell_measures attribute to a diag out field
!!
Expand Down
7 changes: 4 additions & 3 deletions test_fms/diag_manager/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) \
Expand All @@ -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)

Expand All @@ -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=""
Expand Down
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
Loading